-+-+-+-+-+-+-+-+ START OF PART 36 -+-+-+-+-+-+-+-+
Xdefine verb imoria
X        image moria_dir:imoria
X`09parameter p1,`09`09label=finam value(type=$file)
X`09qualifier wizard,`09label=wizard,`09nonnegatable,
X`09`09`09`09value(default="doublespeak")
X`09qualifier score,`09label=score,`09nonnegatable,
X`09`09`09`09value(default="100")
X`09qualifier restore,`09label=restore,`09nonnegatable,
X`09`09`09`09value(type=$file, default=sys$scratch:moriachr.sav)
X`09qualifier undead,`09label=undead,`09nonnegatable,
X`09`09`09`09value(type=$file, default=sys$scratch:moriachr.sav)
X`09qualifier trap,`09`09label=trap,`09negatable,
X`09`09`09`09value(default="10")
X`09qualifier top`09`09label=top,`09negatable,`09default
X`09`09`09`09value(default="20")
X`09qualifier hear`09`09label=warn,`09negatable
X`09qualifier difficulty`09label=difficulty,
X`09`09`09`09nonnegatable,`09value(default=3)
X`09disallow (any2(score,trap,restore) or (top and restore) or
X`09`09 (top and score))
$ CALL UNPACK IMORIA.CLD;1 1229159109
$ create 'f'
X$ define /nolog moria_dir $1$dua12:`5Btemp.masmummy`5D
X$ set command moria_dir:imoria
X$ exit
$ CALL UNPACK IMORIA_SETUP.COM;1 1310340313
$ create 'f'
X`09;`09Robert Koeneke
X`09;`0909-20-84
X`09;`09Module :
X`09;`09`09Insert - Searches for match string and replaces
X`09;`09`09`09 a match with a replacement string.
X`09;`09`09`09 No checking is done.
X`09;
X`09.title`09INSERT_STR`09Insert a string
X`09.ident`09/insert_str/
X`09.psect`09misc1$code,pic,con,rel,lcl,shr,exe,rd,nowrt,2
X`09.entry`09INSERT_STR,`5EM<R2,R3,R4,R5,R6>
X`09movl`094(ap),r4`09`09; Address of source string
X`09movl`098(ap),r5`09`09; Address of match string
X`09matchc`09(r5),2(r5),(r4),2(r4)`09; Look for match
X`09bneq`091$`09`09`09; No match?
X`09movl`09r3,r6`09`09`09; Save for second MOVC
X`09movzwl`09(r5),r0`09`09`09; Length of match string
X`09subl2`09r0,r6`09`09`09; Dest for second MOVC
X`09subw3`09(r5),@12(ap),r1`09`09; rep_len - mtc_len
X`09cvtwl`09r1,r1`09`09`09; Convert to longword
X`09addw`09r1,(r4)`09`09`09; Zap length of source
X`09addl2`09r3,r1`09`09`09; R1=Move to, R3=Move from
X`09movc3`09r2,(r3),(r1)`09`09; Adjust source string
X`09movl`0912(ap),r0`09`09; Address of replace string
X`09movc3`09(r0),2(r0),(r6)`09`09; Put replace string into source
X1$:`09ret
X`09.end
$ CALL UNPACK INSERT.MAR;1 324356802
$ create 'f'
X`5Bglobal,psect(insure$code)`5D procedure buy_insurance;
X
X  var
X`09exit_flag`09: boolean;
X`09shop_owner`09: vtype;
X`09out_val`09`09: vtype;
X`09tics`09`09: integer;
X
X  procedure display_gold;
X    var
X`09out_val`09: vtype;
X    begin
X      writev(out_val,'Gold remaining : ',py.misc.money`5Btotal$`5D:1);
X      prt(out_val,19,18);
X    end;
X
X  procedure display_commands;
X    begin
X      prt('You may:',21,1);
X      prt(' i) Insure an item.          a) Insure all items.',22,1);
X      prt(' e) Insure all equipment.    p) Insure person.',23,1);
X      prt('`5EZ) Exit from building.     `5ER) Redraw the screen.',24,1);
X    end;
X
X  procedure display_store;
X    begin
X      clear(1,1);
X      prt(shop_owner,4,10);
X      prt('(Protects character against most system failures.)',7,15);
X      display_commands;
X      display_gold;
X    end;
X
X  procedure insure_all_items;
X    var
X`09tot_cost,temp,to_bank`09: integer;
X`09ptr`09`09`09: treas_ptr;
X`09flag`09`09`09: boolean;
X`09out`09`09`09: string;
X    begin
X      tot_cost := 0;
X      ptr := inventory_list;
X      while (ptr <> nil) do
X`09begin
X`09  if (uand(insured_bit,ptr`5E.data.flags2) = 0) then
X`09    begin
X`09      temp := trunc(abs(ptr`5E.data.cost * ptr`5E.data.number) / 40);
X`09      if (temp < (mithril$value div 10)) then temp := (mithril$value div
V 10);
X`09      tot_cost := tot_cost + temp;
X`09    end;
X`09  ptr := ptr`5E.next;
X`09end;
X      if (tot_cost > 0) then
X`09begin
X`09  flag := false;
X`09  writev(out,'Do you wish to pay '+cost_str(tot_cost)+'?');
X`09  if (get_yes_no(out)) then
X`09    if ((py.misc.money`5Btotal$`5D * gold$value) >= tot_cost) then
X`09      begin
X`09        subtract_money(tot_cost,true);
X`09        flag := true;
X`09      end
X`09    else
X`09      msg_print('Get some more cash, you homo!');
X`09  if (flag) then
X`09    begin
X`09      ptr := inventory_list;
X`09      while (ptr <> nil) do
X`09`09begin
X`09`09  ptr`5E.data.flags2 := uor(ptr`5E.data.flags2,insured_bit);
X`09`09  ptr := ptr`5E.next;
X`09`09end;
X`09      display_gold;
X`09      msg_print('Your inventory is now insured');
X`09    end;
X`09end
X      else
X`09msg_print('You have no inventory that needs to be insured.');
X    end;
X
X  procedure insure_item;
X    var
X`09ptr`09`09`09: treas_ptr;
X`09count,temp,to_bank`09: integer;
X`09redraw,flag`09`09: boolean;
X`09out`09`09`09: string;
X    begin
X      count := 0;
X      change_all_ok_stats(false,false);
X      ptr := inventory_list;
X      while (ptr <> nil) do
X`09begin
X`09  if (uand(ptr`5E.data.flags2,insured_bit) = 0) then
X`09    begin
X`09      ptr`5E.ok := true;
X`09      count := count + 1;
X`09    end;
X`09  ptr := ptr`5E.next;
X`09end;
X      if (count > 0) then
X       begin
X`09if (get_item(ptr,'Insure which item?',redraw,count,trash_char,false)) the
Vn
X`09  begin
X`09    temp := trunc(abs(ptr`5E.data.cost * ptr`5E.data.number) / 40);
X`09    if (temp < (mithril$value div 10)) then temp := (mithril$value div 10
V);
X`09    flag := false;
X`09    writev(out,'Do you wish to pay '+cost_str(temp)+'?');
X`09    if (get_yes_no(out)) then
X`09      if ((py.misc.money`5Btotal$`5D * gold$value) >= temp) then
X`09        begin
X`09`09  subtract_money(temp,true);
X`09`09  flag := true;
X`09        end
X`09      else
X`09`09msg_print('Why don''t you try again when you have more cash?');
X`09    if (flag) then
X`09      begin
X`09`09ptr`5E.data.flags2 := uor(ptr`5E.data.flags2,insured_bit);
X`09`09display_store;
X`09`09objdes(out_val,ptr,true);
X`09`09if (ptr`5E.data.number > 1) then
X`09`09  msg_print('Your '+out_val+' are now insured')
X`09`09else
X`09`09  msg_print('Your '+out_val+' is now insured');
X`09      end;
X`09  end
X`09else
X`09  display_store;
X       end
X`09else
X`09  msg_print('None of your items need insurance');
X    end;
X
X`09`7B Returns the rate to rape the character at for insurance,
X`09  based on the number of times they have been restored in
X`09  the past.`09`09`09`09`09`09-DMF-`09`7D
X`09`7B Change this after seeing how bad ppl get screwed`09`09`7D
Xfunction death_adj : real;
X  var
X`09temp`09`09: real;
X  begin
X    with py.misc do
X      begin
X`09premium := exp;
X`09if (premium < 100) then premium := 100;
X`09temp := 100 * sqrt(premium) + premium * deaths;
X`09premium := trunc(temp);
X`09death_adj := temp;
X      end;
X  end;
X
X  procedure insure_person;
X    var
X`09tot_cost,to_bank`09: integer;
X`09flag`09`09`09: boolean;
X`09out`09`09`09: string;
X        f1                      : text;
X    begin
X      if (py.flags.insured) then
X`09msg_print('Your person is already insured.')
X      else if (py.misc.deaths>7) then
X        msg_print('You are deemed a security risk.  We will not insure you.'
V)
X`09else begin
X`09  tot_cost := trunc(death_adj);
X`09  if (tot_cost < (2*mithril$value)) then tot_cost := (2*mithril$value);
X`09  flag := false;
X`09  writev(out,'Do you wish to pay '+cost_str(tot_cost)+'?');
X`09  if (get_yes_no(out)) then
X`09    if ((py.misc.money`5Btotal$`5D * gold$value) >= tot_cost) then
X`09      begin
X`09        subtract_money(tot_cost,true);
X`09        flag := true;
X`09      end
X`09    else
X`09      msg_print('Nope, not enough cash with you.');
X`09  if (flag) then
X`09    begin
X`09      display_gold;
X`09      py.flags.insured := true;
X`09      msg_print('Your person is now insured');
X`09    end;
X`09end;
X    end;
X
X  procedure insure_all_equip;
X    var
X`09i1,tot_cost,temp,to_bank: integer;
X`09flag`09`09`09: boolean;
X`09out`09`09`09: string;
X    begin
X      tot_cost := 0;
X      for i1 := equipment_min to equip_max - 1 do
X`09with equipment`5Bi1`5D do
X`09  if (tval > 0) then
X`09    if (uand(insured_bit,flags2) = 0) then
X`09      begin
X`09`09temp := trunc(abs(cost * number) / 40);
X`09`09if (temp < (mithril$value div 10)) then temp := (mithril$value div 10)
V;
X`09`09tot_cost := tot_cost + temp;
X`09      end;
X      if (tot_cost > 0) then
X`09begin
X`09  flag := false;
X`09  writev(out,'Do you wish to pay '+cost_str(tot_cost)+'?');
X`09  if (get_yes_no(out)) then
X`09    if ((py.misc.money`5Btotal$`5D * gold$value) >= tot_cost) then
X`09      begin
X`09        subtract_money(tot_cost,true);
X`09        flag := true;
X`09      end
X`09    else
X`09      msg_print('You don''t have enough money with you.  Maybe you should
V make a withdrawal.');
X`09  if (flag) then
X`09    begin
X`09      for i1 := equipment_min to equip_max - 1 do
X`09`09with equipment`5Bi1`5D do
X`09`09  if (tval > 0) then
X`09`09    flags2 := uor(flags2,insured_bit);
X`09      display_gold;
X`09      msg_print('Your equipment is now insured');
X`09    end;
X`09end
X      else
X`09msg_print('You have no equipment that needs to be insured.');
X    end;
X
X  procedure parse_command;
X    var
X`09command`09`09: char;
X`09com_val, which`09: integer;
X    begin
X      if get_com('',command) then
X`09begin
X`09  com_val := ord(command);
X`09  case com_val of
X`09     18 : display_store;
X`09     97 : insure_all_items;
X`09    105 : if py.flags.insured then insure_item
X                else prt('Insure your body first.',1,1);
X`09    112 : insure_person;
X`09    101 : if py.flags.insured then insure_all_equip
X                else prt('Insure your body first.',1,1);
X`09    otherwise prt('Invalid Command.',1,1);
X`09  end;
X`09end
X      else exit_flag := true;
X    end;
X
X  begin
X    exit_flag := false;
X    tics := 1;
X    shop_owner := 'Mangy Dragon Flye        (Scum)       Insurance';
X    display_store;
X    repeat
X      parse_command;
X      adv_time(false);
X      tics := tics + 1;
X      check_kickout_time(tics,2);
X    until(exit_flag);
X  end;
X
X
X
X
X
X
X
X
X
X
$ CALL UNPACK INSURANCE.INC;1 1684665520
$ create 'f'
X`5Binherit('moria.env','dungeon.env')`5D module inven;
X
X  `5Bglobal,psect(inven$code)`5D
X  function change_all_ok_stats(nok,nin : boolean) : integer;
X      var
X`09`09curse`09: treas_ptr;
X`09`09count`09: integer;
X      begin
X`09count := 0;
X`09curse := inventory_list;
X`09while (curse <> nil) do
X`09  begin
X`09    if (curse`5E.is_in) then
X`09      curse`5E.ok := nin
X`09    else
X`09      curse`5E.ok := nok;
X`09    if (curse`5E.ok) then count := count + 1;
X`09    curse := curse`5E.next;
X`09  end;
X`09change_all_ok_stats := count;
X      end;
X
X
X`09`7B Returns a '*' for cursed items, a ')' for normal ones -RAK-`09`7D
X`09`7B NOTE: '*' returned only if item has been identified...        `7D
X    `5Bglobal,psect(inven$code)`5D function cur_char1 : char;
X      begin
X`09with inven_temp`5E.data do
X`09  if (uand(cursed_worn_bit,flags) = 0) then
X`09    cur_char1 := ')'    `7B Not cursed...                 `7D
X`09  else if (uand(known_cursed_bit,flags2) <> 0) then
X`09    cur_char1 := '*'    `7B Cursed and detected by spell `7D
X`09  else if (index(name,'`5E') > 0) then
X`09    cur_char1 := ')'    `7B Cursed, but not identified    `7D
X`09  else
X`09    cur_char1 := '*';   `7B Cursed and identified...      `7D
X      end;
X
X
X`09`7B Returns a '*' for cursed items, a ')' for normal ones -RAK-`09`7D
X    `5Bglobal,psect(inven$code)`5D function cur_char2 : char;
X      begin
X`09with inven_temp`5E.data do
X`09  if (uand(cursed_worn_bit,flags) = 0) then
X`09    cur_char2 := ')'    `7B Not cursed... `7D
X`09  else
X`09    cur_char2 := '*';   `7B Cursed...     `7D
X      end;
X
X`09`7B Returns a ' ' for uninsured items, a '(' for insured ones -DMF-`7D
X    `5Bglobal,psect(inven$code)`5D function cur_insure : char;
X      begin
X`09with inven_temp`5E.data do
X`09  if (uand(flags2,insured_bit) = 0) then
X`09    cur_insure := ' '
X`09  else
X`09    cur_insure := '(';
X      end;
X
X`09`7B Comprehensive function block to handle all inventory`09-RAK-`09`7D
X`09`7B and equipment routines.  Five kinds of calls can take place.  `7D
X`09`7B Note that '?' is a special call for other routines to display `7D
X`09`7B only a portion of the inventory, and take no other action.    `7D
X    `5Bglobal,psect(inven$code)`5D function inven_command(
X`09`09command`09`09: char;
X`09`09var item_ptr`09: treas_ptr;
X`09`09prompt`09`09: vtype) : boolean;
X      const
X`09display_size`09= 20;
X      var
X`09com_val,scr_state               : integer;
X`09exit_flag,test_flag`09`09: boolean;
X`09save_back`09`09`09: boolean;
X`09blegga`09`09`09`09: treas_ptr;
X`09cur_display`09`09`09: array `5B1..display_size`5D of treas_ptr;
X`09cur_display_size`09`09: integer;
X`09valid_flag`09`09`09: boolean;
X
X
X      procedure clear_display;
X`09var
X`09`09index`09`09`09: integer;
X`09begin
X`09  cur_display_size := 0;
X`09  for index := 1 to display_size do
X`09    cur_display`5Bindex`5D := nil;
X`09end;
X
X`7B start changes into start of next page; returns # items in page`7D
X      function display_inv(start : treas_ptr;
X`09`09`09`09 var next_start : treas_ptr) : integer;
X`09var
X`09`09count,i1 : integer;
X`09`09out_val,out_val2 : vtype;
X`09begin
X`09  count := 0;
X`09  while (start <> nil) and (count < display_size) do
X`09    begin
X`09      if (start`5E.ok) then
X`09`09begin
X`09`09  count := count + 1;
X`09`09  if (cur_display`5Bcount`5D <> start) then
X`09`09    begin
X`09`09      cur_display`5Bcount`5D := start;
X`09`09      inven_temp`5E.data := start`5E.data;
X`09`09      objdes(out_val,inven_temp,true);
X`09`09      if (uand(start`5E.data.flags2,holding_bit) <> 0) then
X`09`09`09if (index(start`5E.data.name,'`7C') = 0) then
X`09`09`09  out_val := out_val + bag_descrip(start);
X`09`09      if (start`5E.is_in) then
X`09`09        writev(out_val2,cur_insure,chr(96+count),cur_char1,
X`09`09`09`09`09'     ',out_val)
X`09`09      else
X`09`09`09writev(out_val2,cur_insure,chr(96+count),cur_char1,
X`09`09`09`09`09' ',out_val);
X`09`09      prt(out_val2,count+1,1);
X`09`09    end;
X`09`09end;
X`09      start := start`5E.next;
X`09    end;
X`09  for i1 := count+1 to display_size do
X`09    begin
X`09      erase_line(i1+1,1);
X`09      cur_display`5Bi1`5D := nil;
X`09    end;
+-+-+-+-+-+-+-+-  END  OF PART 36 +-+-+-+-+-+-+-+-