-+-+-+-+-+-+-+-+ START OF PART 105 -+-+-+-+-+-+-+-+
X`09temp_ray`09: data_array;
X`09i1,i2,i3,gap,l,r: integer;
X`09tmp`09`09: treasure_type;
X`09out_val`09`09: string;
X      begin
X`09for i1 := 1 to max_objects do
X`09  temp_ray`5Bi1`5D := object_list`5Bi1`5D;
X`09gap := max_objects div 2;
X`09while (gap > 0) do
X`09  begin
X`09    for i1 := gap + 1 to max_objects do
X`09      begin
X`09`09i2 := i1 - gap;
X`09`09while (i2 > 0) do
X`09`09  begin
X`09`09    i3 := i2 + gap;
X`09`09    if ((temp_ray`5Bi2`5D.tval > temp_ray`5Bi3`5D.tval) or
X                     ((temp_ray`5Bi2`5D.tval=temp_ray`5Bi3`5D.tval) and
X                     (temp_ray`5Bi2`5D.subval>temp_ray`5Bi3`5D.subval))) the
Vn
X`09`09      begin
X`09`09`09tmp := temp_ray`5Bi2`5D;
X`09`09`09temp_ray`5Bi2`5D := temp_ray`5Bi3`5D;
X`09`09`09temp_ray`5Bi3`5D := tmp;
X`09`09      end
X`09`09    else
X`09`09      i2 := 0;
X`09`09    i2 := i2 - gap;
X`09`09  end;
X`09      end;
X`09    gap := gap div 2;
X`09  end;
X`09new(data_list);
X`09curse := data_list;
X`09curse`5E.data := temp_ray`5B1`5D;
X`09for i1 := 2 to max_objects do
X         if ((temp_ray`5Bi1`5D.tval <> temp_ray`5Bi1-1`5D.tval) or
X             (temp_ray`5Bi1`5D.subval <> temp_ray`5Bi1-1`5D.subval)) then
V   `20
X`09  begin
X`09    new(curse`5E.next);
X`09    curse := curse`5E.next;
X`09    curse`5E.data := temp_ray`5Bi1`5D;
X`09    curse`5E.next := nil;
X`09  end;
X      end;
X    procedure display_commands;
X      begin
X`09prt('You may:',22,1);
X`09prt(' p) Pick an item.              b) Browse to next page.',23,1);
X`09prt('`5EZ) Exit.                     `5ER) Redraw screen.',24,1);
X      end;
X    procedure display_list(start : list_elem_ptr);
X      var
X`09count,old_display_size`09: integer;
X      begin
X`09old_display_size := cur_display_size;
X`09count := 0;
X`09while (start <> nil) and (count < display_size) do
X`09  begin
X`09    count := count + 1;
X`09    if (cur_display`5Bcount`5D <> start) then
X`09      begin
X`09`09cur_display`5Bcount`5D := start;
X`09`09writev(temp,chr(96+count),') ',start`5E.data.name);
X`09`09prt(temp,count+1,1);
X`09      end;
X`09    start := start`5E.next;
X`09  end;
X`09cur_display_size := count;
X`09while (old_display_size > cur_display_size) do
X`09  begin
X`09    erase_line(old_display_size+3,1);
X`09    cur_display`5Bold_display_size`5D := nil;
X`09    old_display_size := old_display_size - 1;
X`09  end;
X`09if (start = nil) then
X`09  blegga := data_list
X`09else
X`09  blegga := start;
X      end;
X    procedure clear_display;
X      begin
X`09cur_display_size := 0;
X`09for i4 := 1 to display_size do
X`09  cur_display`5Bi4`5D := nil;
X      end;
X    procedure display_screen;
X      begin
X`09clear(1,1);
X`09clear_display;
X`09display_list(cur_top);
X`09display_commands;
X      end;
X    function get_list_entry(
X`09`09var com_val`09: integer;
X`09`09pmt`09`09: vtype;
X`09`09i1,i2`09`09: integer) : boolean;
X      var
X`09command`09: char;
X`09flag`09: boolean;
X      begin
X`09com_val := 0;
X`09flag := true;
X`09writev(temp,'(Entries ',chr(i1+96),'-',chr(i2+96),', `5EZ to exit) ',
X`09`09       pmt);
X`09while (((com_val < i1) or (com_val > i2)) and (flag)) do
X`09  begin
X`09    prt(temp,1,1);
X`09    inkey(command);
X`09    com_val := ord(command);
X`09    case com_val of
X`09      3,25,26,27 : flag := false;
X`09      otherwise com_val := com_val - 96;
X`09    end;
X`09  end;
X`09erase_line(1,1);
X`09get_list_entry := flag;
X      end;
X    procedure parse_command;
X      var
X`09command`09`09: char;
X`09com_val,which`09: integer;
X      begin
X`09if get_com('',command) then
X`09  begin
X`09    com_val := ord(command);
X`09    case com_val of
X`7B`5ER`7D`09      18 : display_screen;
X`7Bb`7D`09      98 : begin
X`09`09    if (cur_top = blegga) then
X`09`09      prt('Entire list is displayed.',1,1)
X`09`09    else
X`09`09      begin
X`09`09`09cur_top := blegga;
X`09`09`09display_list(cur_top);
X`09`09      end;
X`09`09   end;
X`7Bp`7D`09     112 : begin
X`09`09     if (cur_display_size > 0) then
X`09`09       if (get_list_entry(which,' Pick which one?',1,
X`09`09`09`09`09  cur_display_size)) then
X`09`09`09 begin
X`09`09`09   exit_flag := true;
X`09`09`09   wizard_moo_item := true;
X`09`09`09   back := cur_display`5Bwhich`5D`5E.data;
X`09`09`09 end;
X`09`09   end;
X`09      otherwise prt('Invalid command',1,1);
X`09    end;
X`09  end
X`09else
X`09  exit_flag := true;
X      end;
X
X    begin
X      back := blank_treasure;
X      init_data_list;
X      exit_flag := false;
X      cur_top := data_list;
X      display_screen;
X      wizard_moo_item := false;
X      while not exit_flag do parse_command;
X    end;
X
X
X`09`7B Wizard routine to summon a random item by substring(s) of its
X`09  name, with a maximum # of tries`09`09`09-DMF-`09`7D
X  `5Bglobal,psect(wizard$code)`5D function summon_item (
X`09`09y,x`09: integer;
X`09`09name1`09: ttype;
X`09`09name2`09: ttype;
X`09`09count`09: integer;
X`09`09present : boolean) : boolean;
X
X    const
X`09low_num = -987654321;
X    var
X`09i1,i2,num_found`09`09: integer;
X`09optimize`09`09: integer;
X`09best_value,good_value`09: integer;
X`09best_pick,good_pick`09: treasure_type;
X`09flag,done,found`09`09: boolean;
X`09out_str`09`09`09: string;
X`09cur_pos`09`09`09: integer;
X`09command`09`09`09: char;
X`09moo_item`09`09: data_array;
X`09moo_cursor`09`09: array `5B1..max_objects`5D of integer;
X
X
X`7Bask wizard for item information/Moo!, Moo./Moo?`7D
X      function get_item_descriptions : boolean;
X        var ook : boolean;
X
X`7Bprompts for new string, <CR> leaves old value`7D
X`09function get_new_ttype(var s : ttype; str : vtype) : boolean;
X          var os : ttype;
X`09  begin
X`09    get_new_ttype := false;
X`09    if (length(s) > 0) then
X`09      writev(out_str,str,' `5B',s,'`5D : ')
X`09    else
X`09      writev(out_str,str,' : ');
X`09    prt(out_str,1,1);
X`09    os := s;
X`09    if (get_string(s,1,length(out_str)+1,40)) then
X`09      begin
X`09`09get_new_ttype := true;
X`09`09if ((length(os) > 0) and (length(s) = 0)) then
X`09  `09  s := os;
X`09      end;
X`09  end; `7B get_new_ttype `7D
X
X`09begin
X          get_item_descriptions := false;
X`09  if get_new_ttype(s1,'Item string') then
X`09    begin
X`09      ook := true;`09
X`09      if (index(s1,'Moo!') = 1) then
X`09`09begin
X`09`09  moo_item`5B1`5D := blank_treasure;
X`09`09  ook := wizard_moo_item(moo_item`5B1`5D);
X`09`09  if ook then
X`09`09    begin
X`09`09      found := true;
X`09`09      num_found := 1;
X`09`09    end;`09
X`09`09  draw_cave;
X`09`09end;
X`09      if ook then
X`09       if get_new_ttype(s2,'More stuff #1') then
X`09`09if get_new_ttype(s3,'More stuff #2') then
X`09`09 if get_new_ttype(s4,'Special') then
X`09`09  begin
X`09`09    if (i_summ_count > 0) then
X`09      `09`09writev(out_str,'Maximum number of tries: `5B',i_summ_count:1,
V'`5D : ')
X`09`09    else
X`09`09      out_str := 'Maximum number of tries: ';
X`09`09    prt(out_str,1,1);
X`09`09    if (get_string(out_str,1,length(out_str)+1,60)) then
X`09`09      get_item_descriptions := true
X`09`09  end
X`09    end
X`09end; `7B get_item_descriptions `7D
X
X`7B use 3 substrings to narrow down specify possible items `7D
X      function narrow_choices : boolean;
X`09var i1,i2 : integer;
X
X  `7B eliminate all items without string s from array moo_cursor `7D
X`09function narrow(var s : ttype) : boolean;
X          begin
X`09    narrow := false;
X`09    i2 := 1;
X`09    if (length(s) > 0) then`20
X`09      for i1 := 1 to num_found do
X`09  `09if (index(object_list`5Bmoo_cursor`5Bi1`5D`5D.name,s) > 0) then
X`09  `09  begin
X`09`09    moo_cursor`5Bi2`5D := moo_cursor`5Bi1`5D;
X`09  `09    i2 := i2 + 1;
X`09          end;
X`09    if (i2 > 1) then
X`09      begin
X`09`09narrow := true;`09`7Bat least one feasible substring found`7D
X`09`09num_found := i2 - 1;
X`09      end
X          end; `7B narrow `7D
X
X`09begin
X`09  narrow_choices := false;
X`09  for i1 := 1 to max_objects do
X`09    moo_cursor`5Bi1`5D := i1;
X`09  num_found := max_objects;
X`09  if (narrow(s1)) then
X`09    begin
X`09      narrow_choices := true;
X`09      if narrow(s2) then
X`09`09narrow(s3);
X`09      for i1 := 1 to num_found do
X`09`09moo_item`5Bi1`5D := object_list`5Bmoo_cursor`5Bi1`5D`5D;
X`09    end;
X`09end; `7B narrow_choices `7D
X
X`7B init variables, see if optimizing (1=best, -1= worst); find # of tries `
V7D`20
X      procedure pesky_stuff;
X`09var omax : integer;
X`09begin
X`09  best_value := low_num;
X`09  good_value := low_num;
X`09  best_pick := yums`5B5`5D; `7Brice-a-roni`7D
X`09  good_pick := yums`5B5`5D;
X`09  if (index(s4,'Moo.') > 0) then
X`09        optimize := 1
X`09  else if (index(s4,'Moo?') > 0) then
X`09      optimize := -1
X`09  else
X`09    optimize := 0;
X`09  omax := i_summ_count;
X`09  readv(out_str,i_summ_count,error:=continue);
X`09  if (i_summ_count = 0) then
X`09    i_summ_count := omax;
X`09  if (i_summ_count <= 0) then
X`09    i_summ_count := 1;
X`09  popt(cur_pos);
X`09  cave`5By,x`5D.tptr := cur_pos;
X`09end;
X
X`7B formula for comparing value of items`7D
X      function optimize_item(var pick : treasure_type;
X`09`09`09`09var value : integer) : boolean;
X`09var i1 : integer;
X`09begin
X`09  optimize_item := false;
X`09  with t_list`5Bcur_pos`5D do
X`09    begin
X`09      i1 := optimize * (cost + tohit + todam + toac);
X`09      if (i1 > value) then
X`09`09  begin
X`09`09    value := i1;
X`09`09    pick := t_list`5Bcur_pos`5D;
X`09`09    optimize_item := true;
X`09`09  end;
X`09    end;
X`09end;
X
X    begin
X      summon_item := false;
X      found := false;
X      done := false;
X      if present then
X`09begin
X`09  flag := (length(name1) <> 0);
X`09  s1 := name1;
X`09  s2 := name2;
X`09  s3 := '';
X`09  s4 := 'Moo.';
X`09  writev(out_str,count:1);
X`09end
X      else
X`09flag := get_item_descriptions; `7Bfound := true iff successful Moo!`7D
X      if (flag) then
X`09begin
X`09  pesky_stuff;
X`09  if (not found) then
X`09    found := narrow_choices;  `7Bcreate array of all ok choices`7D
X`09  if (found) then
X`09   begin
X`09    if (not present) then
X`09      begin
X`09        msg_print('Press any key to abort...');
X`09        put_qio;
X`09      end;
X`09    i1 := 0;
X`09    while (i1 < i_summ_count) and (not done) do
X`09      begin
X`09        t_list`5Bcur_pos`5D:=moo_item`5B((num_found*i1) div i_summ_count)
V+1`5D;
X`09`09if (not present) then
X`09`09  begin
X`09`09    inkey_delay(command,0);
X`09`09    done := (command <> null);
X`09`09  end;
X`09`09magic_treasure(cur_pos,1000);
X`09`09if (((length(s2) = 0) or (index(t_list`5Bcur_pos`5D.name,s2) <> 0)) an
Vd
X`09 `09   ((length(s3) = 0) or (index(t_list`5Bcur_pos`5D.name,s3) <> 0))) t
Vhen
X`09`09  begin
X`09`09    if optimize_item(best_pick,best_value) then
X`09`7B leave loop prematurely if not optimizing and item is found `7D
X`09`09      if (optimize = 0) then
X`09`09`09done := true
X`09`09  end
X`09`7B while no correct pick, get best non-correct item `7D
X`09`09else if ((optimize <> 0) and (best_value = low_num)) then
X`09`09  optimize_item(good_pick,good_value);
X`09`09i1 := i1 + 1
X`09      end;`09`7B while `7D
X`09   end;
X`09  if (best_value > low_num) then
X`09    begin
X`09      msg_print('Allocated.');
X`09      t_list`5Bcur_pos`5D := best_pick;
X`09      with t_list`5Bcur_pos`5D do
X`09`09if (subval > 255) then
X`09`09  begin
X`09`09    i2 := cost;
X`09`09    if (i2 < 3) then i2 := 3;
X`09`09    number:=trunc(i_summ_count/sqrt(100*i2 div gold$value));
X`09`09    if (number < 1) then number := 1
X`09`09    else if (number > 100) then number := 100;
X`09`09  end;
X`09    end
X`09  else if (good_value > low_num) then
X`09    begin
X`09      msg_print('Found, but not perfect match.');
X`09      t_list`5Bcur_pos`5D := good_pick;
X`09    end
X`09  else
X`09    begin
X`09      msg_print('Unfortunately your wish did not come true.');
X    msg_print('You have, however, been awarded a valuable consolation gift!'
V);`20
X`09      t_list`5Bcur_pos`5D := yums`5B5`5D; `7Brice`7D
X`09      t_list`5Bcur_pos`5D.number := 12;
X`09    end;
X`09  summon_item := true;
X`09end`09`7B if flag `7D
X      else
X`09msg_print('Invalid input');
X    end;
X
X
X`09`7B Wizard routine for gaining on stats`09`09`09-RAK-`09`7D
X`5Bglobal,psect(wizard$code)`5D  procedure change_character;
X    var
X`09tmp_val`09`09`09: integer;
X`09tmp_str`09`09`09: vtype;
X`09flag`09`09`09: boolean;
X    label
X`09abort;
X    function input_field(
X`09`09prompt`09`09: string;
X`09`09var num`09`09: integer;
X`09`09min,max`09`09: integer;
X`09`09var ok`09`09: boolean) : boolean;
X      var
X`09out_val`09: string;
X`09len`09: integer;
X      begin
X`09writev(out_val,'Current = ',num:1,', ',prompt);
X`09len := length(out_val);
X`09prt(out_val,1,1);
X`09if (get_string(out_val,1,len+1,10)) then
X`09  begin
X`09    len := -999;
X`09    readv(out_val,len,error:=continue);
X`09    if ((len >= min) and (len <= max)) then
X`09      begin
X`09`09ok := true;
X`09`09num := len;
X`09      end
X`09    else
X`09      ok := false;
X`09    input_field := true;
X`09  end
X`09else
X`09  input_field := false;
X      end;
X    begin
X      flag := false;
X      with py.stat do
X`09begin
X`09 for tstat := sr to ca do begin
X`09  case tstat of
X`09   sr :  prt('(0 - 250) Strength     = ',1,1);`20
X`09   iq :  prt('(0 - 250) Intelligence = ',1,1);
X `09   ws :  prt('(0 - 250) Wisdom       = ',1,1);
X`09   dx :  prt('(0 - 250) Dexterity    = ',1,1);
X`09   cn :  prt('(0 - 250) Constitution = ',1,1);`20
X`09   ca :  prt('(0 - 250) Charisma     = ',1,1);
X`09  end;
X`09  if not get_string(tmp_str,1,26,10) then goto abort;
X`09  tmp_val := -999;
X`09  readv(tmp_str,tmp_val,error:=continue);
X`09  if (tmp_val <> -999) then
X`09    begin
X`09      tmp_val := squish_stat(tmp_val);
X`09      p`5Btstat`5D := tmp_val;
X`09      c`5Btstat`5D := tmp_val;
X`09      prt_a_stat(tstat);
X`09    end;
X`09 end;
X`09end;
X      with py.misc do
X`09begin
X`09  tmp_val := mhp;
X`09  if input_field('(1-32767) Hit points = ',tmp_val,1,32767,flag) then
X`09    begin
X`09      if flag then
X`09`09begin
X`09`09  mhp := tmp_val;
X`09`09  chp := mhp;
X`09`09  prt_hp;
X`09`09end;
X`09    end
X`09  else
X`09    goto abort;
X`09  tmp_val := mana;
X`09  if is_magii then
+-+-+-+-+-+-+-+-  END  OF PART 105 +-+-+-+-+-+-+-+-