-+-+-+-+-+-+-+-+ START OF PART 55 -+-+-+-+-+-+-+-+
X`5Bpsect(misc4$code)`5D procedure place_stuck_door(y,x : integer);
X    var
X        cur_pos   : integer;
X  begin
X    popt(cur_pos);
X    with cave`5By,x`5D do
X      begin
X        tptr := cur_pos;
X        t_list`5Bcur_pos`5D := door_list`5B2`5D;
X        fval  := corr_floor3.ftval;
X        fopen := false;
X        t_list`5Bcur_pos`5D.p1 := -randint(10) - 10;
X      end;
X  end;
X`20
X`20
X`5Bpsect(misc4$code)`5D procedure place_secret_door(y,x : integer);
X    var
X        cur_pos   : integer;
X  begin
X    popt(cur_pos);
X    with cave`5By,x`5D do
X      begin
X        tptr := cur_pos;
X        t_list`5Bcur_pos`5D := door_list`5B3`5D;
X        fval  := corr_floor4.ftval;
X        fopen := false;
X      end;
X  end;
X`20
X`20
X`5Bpsect(misc4$code)`5D procedure place_door(y,x : integer);
X    var
X        cur_pos   : integer;
X  begin
X    case randint(3) of
X      1 : case randint(4) of
X            1    : place_broken_door(y,x);
X            otherwise     place_open_door(y,x);
X          end;
X      2 : case randint(12) of
X            1,2  : place_locked_door(y,x);
X            3    : place_stuck_door(y,x);
X            otherwise     place_closed_door(y,x);
X          end;
X      3 : place_secret_door(y,x);
X    end;
X  end;
X`20
X`20
X`20
X`7B Place an up staircase at given y,x    `7D
X`5Bpsect(misc4$code)`5D procedure place_up_stairs(y,x : integer);
X    var
X        cur_pos,i3    : integer;
X    begin
X      with cave`5By,x`5D do
X        if (tptr <> 0) then
X          begin
X            pusht(tptr);
X            tptr := 0;
X            fopen := true;
X          end;
X      popt(cur_pos);
X      cave`5By,x`5D.tptr := cur_pos;
X      case randint(10) of
X      1,2,3,4,5: i3 := 1;
X`09  6,7,8: i3 := 2;
X`09   9,10: i3 := 3;
X      end;
X      t_list`5Bcur_pos`5D := up_stair`5Bi3`5D;
X    end;
X`20
X`7B Place a down staircase at given y,x   `7D
X`5Bpsect(misc4$code)`5D procedure place_down_stairs(y,x : integer);
X    var
X        cur_pos,i3   `09 : integer;
X    begin
X      with cave`5By,x`5D do
X        if (tptr <> 0) then
X          begin
X            pusht(tptr);
X            tptr := 0;
X            fopen := true;
X          end;
X      popt(cur_pos);
X      cave`5By,x`5D.tptr := cur_pos;
X      case randint(10) of`20
X      1,2,3,4,5: i3 := 1;
X`09  6,7,8: i3 := 2;
X           9,10: i3 := 3;
X      end;
X      t_list`5Bcur_pos`5D := down_stair`5Bi3`5D;
X    end;
X`20
X`7B Places a staircase 1=up, 2=down   `7D
X`5Bpsect(misc4$code)`5D procedure place_stairs(typ,num,walls : integer);
X    var
X        i1,i2,y1,x1,y2,x2 : integer;
X        flag       : boolean;
X    begin
X      for i1 := 1 to num do
X          begin
X            flag := false;
X            repeat
X              i2 := 0;
X              repeat
X                y1 := randint(cur_height - 12);
X                x1 := randint(cur_width  - 12);
X                y2 := y1 + 12;
X                x2 := x1 + 12;
X                repeat
X                  repeat
X                    with cave`5By1,x1`5D do
X                      if (fval in `5B1,2,4`5D) then
X                        if (tptr = 0) then
X                          if (next_to4(y1,x1,wall_set) >= walls) then
X                            begin
X                              flag := true;
X                              case typ of
X                                1 : place_up_stairs(y1,x1);
X                                2 : place_down_stairs(y1,x1);
X                              end;
X                            end;
X                    x1 := x1 + 1;
X                  until ((x1 = x2) or (flag));
X                  x1 := x2 - 12;
X                  y1 := y1 + 1;
X                until ((y1 = y2) or (flag));
X                i2 := i2 + 1;
X              until ((flag) or (i2 > 30));
X              walls := walls - 1;
X            until(flag);
X          end;
X    end;
X`20
X`20
X`7B Places a treasure (Gold or Gems) at given row, column `7D
X`5Bpsect(misc4$code)`5D procedure place_gold(y,x : integer);
X    var
X        cur_pos,i1       : integer;
X    begin
X      popt(cur_pos);
X      i1 := trunc((randint(dun_power+2)+2)/2.0);
X      if (randint(obj_great) = 1) then
X        i1 := i1 + randint(dun_power);
X      if (i1 > max_gold) then
X        i1 := randint(max_gold-8)+8;
X      cave`5By,x`5D.tptr := cur_pos;
X      t_list`5Bcur_pos`5D := gold_list`5Bi1`5D;
X      with t_list`5Bcur_pos`5D do
X        cost := randint(6*cost) + cost;
X    end;
X`20
X`20
X`7B Returns the array number of a random object   `7D
X`5Bpsect(misc4$code)`5D function get_obj_num(level : integer) : integer;
X    var
X        i1      : integer;
X    begin
X      if (level > max_obj_level)  then level := max_obj_level;
X      if (randint(obj_great) = 1) then level := max_obj_level;
X      if (level = 0) then
X        i1 := randint(t_level`5B0`5D)
X      else
X        i1 := randint(t_level`5Blevel`5D);
X      get_obj_num := i1;
X    end;
X`20
X
X`7B Pre-declaration. Code located in TREASURE.INC `7D
X`5Bpsect(misc4$code)`5D procedure magic_treasure(var item  : treasure_type;
X`09`09`09`09`09`09 power :       integer);`20
X  forward;
X
X`7B Places an object at given row, column co-ordinate `7D
X`5Bpsect(misc4$code)`5D procedure place_object(y,x : integer);
X    var
X        cur_pos  : integer;
X    begin
X      popt(cur_pos);
X      cave`5By,x`5D.tptr := cur_pos;
X      t_list`5Bcur_pos`5D := object_list`5Bget_obj_num(dun_power)`5D;
X      magic_treasure(t_list`5Bcur_pos`5D,dun_power);
X    end;
X`20
X`20
X`7B Allocates an object for tunnels and rooms `7D
X`5Bpsect(misc4$code)`5D procedure alloc_object(alloc_set : obj_set;
X`09`09`09`09`09   typ,num   : integer);
X    var
X        i1,i2,i3  : integer;
X    begin
X      for i3 := 1 to num do
X        begin
X          repeat
X            i1 := randint(cur_height);
X            i2 := randint(cur_width);
X          until ((cave`5Bi1,i2`5D.fval in alloc_set) and
X                 (cave`5Bi1,i2`5D.tptr = 0));
X          case typ of
X            1 : place_trap(i1,i2,1,randint(max_trapa));
X            2 : place_trap(i1,i2,2,randint(max_trapb));
X            3 : place_rubble(i1,i2);
X            4 : place_gold(i1,i2);
X            5 : place_object(i1,i2)
X          end
X        end
X    end;
X`20
X`20
X`7B Creates objects nearby the coordinates given  `7D
X`5Bpsect(misc4$code)`5D procedure random_object(y,x,num : integer);
X    var
X        i1,i2,i3  : integer;
X    begin
X      repeat
X        i1 := 0;
X        repeat
X          i2 := y - 3 + randint(5);
X          i3 := x - 4 + randint(7);
X          with cave`5Bi2,i3`5D do
X            if (fval in floor_set) then
X              if (tptr = 0) then
X                begin
X                  if (randint(100) < 75) then
X                    place_object(i2,i3)
X                  else
X                    place_gold(i2,i3);
X                    i1 := 9;
X                end;
X          i1 := i1 + 1;
X        until (i1 > 10);
X        num := num - 1;
X      until (num = 0);
X    end;
X`20
X`20
X`7B Converts stat num into string `7D
X`5Bpsect(misc5$code)`5D procedure cnv_stat  (
X                        stat        : byteint;
X                        var out_val : stat_type
X                                        );
X    var
X        tmp_str     : vtype;
X        part1,part2 : integer;
X    begin
X      if (stat > 18) then
X        begin
X          part1 := 18;
X          part2 := stat - 18;
X          writev(tmp_str,part1:2,'/',part2:1);
X        end
X      else
X        writev(tmp_str,stat:2);
X      if (length(tmp_str) < 6) then tmp_str := pad(tmp_str,' ',6);
X      out_val := tmp_str;
X    end;
X`20
X`20
X`7B Print character info in given row, column `7D
X`5Bpsect(misc5$code)`5D procedure prt_field(info : vtype; row,column : integ
Ver);
X
X      begin
X        put_buffer(pad(info,' ',14),row,column);
X      end;
X`20
X`20
X`7B Print number with header at given row, column `7D
X`5Bpsect(misc5$code)`5D procedure prt_num   ( header   `09 : vtype;
X`09`09`09`09`09  num,row,column : integer);
X      var
X                out_val   : vtype;
X      begin
X        writev(out_val,header,num:1,' ');
X        put_buffer(out_val,row,column);
X      end;
X
X`20
X`7B Print character stat in given row, column `7D
X`5Bpsect(misc5$code)`5D procedure prt_stat  ( stat_name   :   vtype;
X`09`09`09`09`09  stat        : byteint;
X`09`09`09`09`09  row,column  : integer);
X      var
X                stat_val  : stat_type;
X                out_val   : vtype;
X      begin
X        prt_num(stat_name,stat,row,column);
X
X       `7B cnv_stat(stat,stat_val);
X         out_val := stat_name + stat_val;  ((the old system....))
X         put_buffer(out_val,row,column);   `7D
X
X      end;
X`20
X`20
X`7B prints game time in stat block. --jeb`7D
X`5Bpsect(misc5$code)`5D procedure prt_time;
X`09var
X          hours   : integer;
X`09  minutes : integer;
X`09  weekday : dtype;
X`09  out_val : ctype;
X`09  str`09  : ctype;
X  BEGIN
X`09  case (day mod 7) of
X`09      0: weekday := 'SUN';
X`09      1: weekday := 'MON';
X`09      2: weekday := 'TUE';
X`09      3: weekday := 'WED';
X`09      4: weekday := 'THU';
X`09      5: weekday := 'FRI';
X`09      6: weekday := 'SAT';
X`09  end;
X`09  writev(out_val,weekday,day:3,' ');
X`09  minutes := (turn mod 720) div 12;
X`09  hours := turn div 720;
X`09  if (hours < 10) then
X`09    out_val := out_val + '0';`09   `20
X`09  writev(str,out_val,hours:1,':');
X`09  if (minutes < 10) then
X`09    str := str + '0';
X`09  writev(out_val,str,minutes:1);
X`09  put_buffer(out_val,23,1)
X  END;
X
X
X`7BDecrease py.flags after mass turn increment - RLG`7D
X`5Bpsect(misc2$code)`5D procedure zero_pyflag;
X    `20
X     BEGIN`09`09  `20
X       with py.flags do
X         Begin
X`09   if (blind>0) then blind := 1;
X`09   if (paralysis>0) then paralysis := 1;
X`09   if (confused>0) then confused := 1;
X`09   if (protection>0) then protection := 1;
X`09   if (fast>0) then fast := 1;
X`09   if (slow>0) then slow := 1;
X`09   if (afraid>0) then afraid := 1;
X`09   if (poisoned>0) then poisoned := 1;
X`09   if (image>0) then image := 1;
X`09   if (protevil>0) then protevil := 1;
X`09   if (invuln>0) then invuln := 1;
X`09   if (hero>0) then hero := 1;
X`09   if (shero>0) then shero := 1;
X`09   if (blessed>0) then blessed := 1;
X`09   if (resist_heat>0) then resist_heat := 1;
X`09   if (resist_cold>0) then resist_cold := 1;
X`09   if (detect_inv>0) then detect_inv := 1;
X`09   if (tim_infra>0) then tim_infra := 1;
X `09   word_recall := 0;
X`09 End;
X     END;
X
X`7B Adjustment for wisdom `7D
X`5Bpsect(misc2$code)`5D function wis_adj : integer;
X    begin
X      if (py.stat.cwis > 49) then
X        wis_adj := 10
X      else if (py.stat.cwis > 44) then
X        wis_adj := 9
X      else if (py.stat.cwis > 39) then
X        wis_adj := 8
X      else if (py.stat.cwis > 34) then
X        wis_adj := 7
X      else if (py.stat.cwis > 29) then
X        wis_adj := 6
X      else if (py.stat.cwis > 24) then
X        wis_adj := 5
X      else if (py.stat.cwis > 19) then
X        wis_adj := 4
X      else if (py.stat.cwis > 17) then
X        wis_adj := 3
X      else if (py.stat.cwis > 14) then
X        wis_adj := 2
X      else if (py.stat.cwis > 7) then
X        wis_adj := 1
X      else
X        wis_adj := 0;
X    end;
X`20
X`20
X`7B adjustment for intellegence   `7D
X`5Bpsect(misc2$code)`5D function int_adj : integer;
X    begin
X      if (py.stat.cint > 49) then
X        int_adj := 10
X      else if (py.stat.cint > 44) then
X        int_adj := 9
X      else if (py.stat.cint > 39) then
X        int_adj := 8
X      else if (py.stat.cint > 34) then
X        int_adj := 7
X      else if (py.stat.cint > 29) then
X        int_adj := 6
X      else if (py.stat.cint > 24) then
X        int_adj := 5
X      else if (py.stat.cint > 19) then
X        int_adj := 4
X      else if (py.stat.cint > 17) then
X        int_adj := 3
X      else if (py.stat.cint > 14) then
X        int_adj := 2
X      else if (py.stat.cint > 7) then
X        int_adj := 1
X      else
X        int_adj := 0;
X    end;
X`20
X`20
X`7B Adjustment for charisma `7D
X`5Bpsect(misc2$code)`5D function chr_adj : integer;
X    begin
X      if (py.stat.cchr > 49) then
X        chr_adj := 10
X      else if (py.stat.cchr > 44) then
X        chr_adj := 9
X      else if (py.stat.cchr > 39) then
X        chr_adj := 8
X      else if (py.stat.cchr > 34) then
X        chr_adj := 7
X      else if (py.stat.cchr > 29) then
X        chr_adj := 6
X      else if (py.stat.cchr > 24) then
X        chr_adj := 5
X      else if (py.stat.cchr > 19) then
X        chr_adj := 4
X      else if (py.stat.cchr > 17) then
X        chr_adj := 3
X      else if (py.stat.cchr > 14) then
X        chr_adj := 2
X      else if (py.stat.cchr > 7 ) then
X        chr_adj := 1
X      else
X        chr_adj := 0;
X    end;
X`20
X`7B Charisma adjustment for buy/sell prices  -RLG `7D                     `2
V0
X`5Bpsect(misc2$code)`5D function chr_padj : real; `20
X    begin
X       if (py.stat.cchr > 49) then
X         chr_padj := -0.20
X       else if (py.stat.cchr > 44) then
X         chr_padj := -0.18
X       else if (py.stat.cchr > 39) then
X         chr_padj := -0.16
X       else if (py.stat.cchr > 34) then
X         chr_padj := -0.14
X       else if (py.stat.cchr > 29) then
X         chr_padj := -0.12
X       else if (py.stat.cchr > 24) then
X         chr_padj := -0.10
X       else if (py.stat.cchr > 19) then
X         chr_padj := -0.08
X       else if (py.stat.cchr > 17) then
X         chr_padj := -0.04
X       else if (py.stat.cchr > 15) then
X         chr_padj := -0.02
X       else if (py.stat.cchr > 12) then
X         chr_padj :=  0.05
X       else if (py.stat.cchr >  9) then
X         chr_padj := 0.10
X       else if (py.stat.cchr >  6) then
X         chr_padj := 0.20
X       else if (py.stat.cchr >  3) then
X         chr_padj := 0.25
X       else
X         chr_padj := 0.30
X    end;
X`20
X`7B Returns a character's adjustment to hit points    `7D
X`5Bpsect(misc2$code)`5D function con_adj : integer;
X  begin
X    with py.stat do
X      if      (ccon <   4) then con_adj := -3
X      else if (ccon <   6) then con_adj := -2
X      else if (ccon <   9) then con_adj := -1
+-+-+-+-+-+-+-+-  END  OF PART 55 +-+-+-+-+-+-+-+-