-+-+-+-+-+-+-+-+ START OF PART 82 -+-+-+-+-+-+-+-+
X`09`09  msg_print('This is getting no where...  I''m going home!');
X`09`09  msg_print('Come back tomorrow...');
X`09`09  msg_print(' ');
X`09`09end;
X`09  4 :`09begin
X`09`09  msg_print('BAH!  No more shall you insult me!');
X`09`09  msg_print('Leave my place...  Begone!');
X`09`09  msg_print(' ');
X`09`09end;
X`09  5 :`09begin
X`09`09  msg_print('Begone!  I have had enough abuse for one day.');
X`09`09  msg_print('Come back when thou art richer...');
X`09`09  msg_print(' ');
X`09`09end;
X`09end;
X`09msg_flag := false;
X      end;
X
X`5Bglobal,psect(store$code)`5D procedure prt_comment5;
X      begin
X`09case randint(10) of
X`09  1  :`09msg_print('You will have to do better than that!');
X`09  2  :`09msg_print('That''s an insult!');
X`09  3  :`09msg_print('Do you wish to do business or not?');
X`09  4  :`09msg_print('Hah!  Try again...');
X`09  5  :`09msg_print('Ridiculous!');
X`09  6  :`09msg_print('You''ve got to be kidding!');
X`09  7  :`09msg_print('You better be kidding!!');
X`09  8  :`09msg_print('You try my patience.');
X`09  9  :`09msg_print('I don''t hear you.');
X`09 10  :`09msg_print('Hmmm, nice weather we''re having...');
X`09end;
X      end;
X
X
X`5Bglobal,psect(store$code)`5D procedure prt_comment6;
X      begin
X`09case randint(5) of
X`09  1  :`09msg_print('I must of heard you wrong...');
X`09  2  :`09msg_print('What was that?');
X`09  3  :`09msg_print('I''m sorry, say that again...');
X`09  4  :`09msg_print('What did you say?');
X`09  5  :`09msg_print('Sorry, what was that again?');
X`09end;
X      end;
X
X
X`09`7B Displays the set of commands`09`09`09`09-RAK-`09`7D
X`5Bglobal,psect(store$code)`5D procedure display_commands;
X      begin
Xprt('You may:',21,1);
Xprt(' p/P) Purchase an item.          <space> browse store''s inventory.',22
V,1);
Xprt(' s/S) Sell an item.              i) Inventory and Equipment Lists.',23,
V1);
Xprt('  `5EZ) Exit from Building.       `5ER) Redraw the screen.',24,1);
X      end;
X
X
X`09`7B Displays the set of commands`09`09`09`09-RAK-`09`7D
X`5Bglobal,psect(store$code)`5D procedure haggle_commands(typ : integer);
X      begin
X`09if (typ = -1) then
X`09  prt('Specify an asking-price in gold pieces.',22,1)
X`09else
X`09  prt('Specify an offer in gold pieces.',22,1);
X`09prt('`5EZ) Quit Haggling.',23,1);
X`09prt('',24,1);
X      end;
X
X
X`09`7B Displays a store's inventory`09`09`09`09-RAK-`09`7D
X`5Bglobal,psect(store$code)`5D procedure display_inventory(store_num,start :
V integer);
X      var
X`09i1,i2,stop`09`09`09: integer;
X`09out_val1,out_val2`09`09: vtype;
X      begin
X`09with store`5Bstore_num`5D do
X`09    begin
X`09      i1 := ((start-1) mod 12);
X`09      stop := (((start-1) div 12) + 1)*12;
X`09      if (stop > store_ctr) then stop := store_ctr;
X`09      while (start <= stop) do
X`09        begin
X`09`09  inven_temp`5E.data := store_inven`5Bstart`5D.sitem;
X`09`09  with inven_temp`5E.data do
X`09`09    if ((subval > 255) and (subval < 512)) then
X`09`09      number := 1;
X`09`09  objdes(out_val1,inven_temp,true);
X`09`09  writev(out_val2,chr(97+i1),') ',out_val1);
X`09`09  prt(out_val2,i1+6,1);
X`09`09  if (store_inven`5Bstart`5D.scost < 0) then
X`09`09    begin `7Bquack`7D
X`09`09      i2 := abs(store_inven`5Bstart`5D.scost);
X`09`09      i2 := i2 + trunc(i2*chr_adj);
X`09`09      writev(out_val2,((i2+gold$value-1) div gold$value):6);
X`09`09    end
X`09`09  else
X`09`09    writev(out_val2,(store_inven`5Bstart`5D.scost div gold$value):6,'
V `5BFixed`5D');
X`09`09  prt(out_val2,i1+6,60);
X`09`09  i1 := i1 + 1;
X`09`09  start := start + 1;
X`09        end;
X`09      if (i1 < 12) then
X`09        for i2 := 1 to (12 - i1 + 1) do
X`09`09  prt('',i2+i1+5,1);
X`09    end;
X      end;
X
X
X`09`7B Re-displays only a single cost`09`09`09-RAK-`09`7D
X`5Bglobal,psect(store$code)`5D procedure display_cost(store_num,pos : intege
Vr);
X      var
X`09i1`09`09`09`09: integer;
X`09out_val`09`09`09`09: vtype;
X      begin
X`09with store`5Bstore_num`5D do
X`09  begin
X`09    i1 := ((pos-1) mod 12);
X`09    if (store_inven`5Bpos`5D.scost < 0) then
X`09      begin
X`09`09i2 := abs(store_inven`5Bpos`5D.scost);
X`09`09i2 := i2 + trunc(i2*chr_adj);
X`09`09writev(out_val,(i2 div gold$value):6);
X`09      end
X`09    else
X`09      writev(out_val,(store_inven`5Bpos`5D.scost div gold$value):6,' `5BF
Vixed`5D');
X`09    prt(out_val,i1+6,60);
X`09  end;
X      end;
X
X
X`09`7B Displays players gold`09`09`09`09`09-RAK-`09`7D
X`5Bglobal,psect(store$code)`5D procedure store_prt_gold;
X      var
X`09out_val`09`09`09: vtype;
X      begin
X`09writev(out_val,'Gold Remaining : ',py.misc.money`5Btotal$`5D:1);
X        prt(out_val,19,18);
X      end;
X
X
X`09`7B Displays store`09`09`09`09`09-RAK-`09`7D
X`5Bglobal,psect(store$code)`5D procedure display_store(store_num,cur_top : i
Vnteger);
X      begin
X`09with store`5Bstore_num`5D do
X`09  begin
X`09    clear(1,1);
X`09    prt(owners`5Bowner`5D.owner_name,4,10);
X`09    prt('   Item',5,1);
X`09    prt('Asking Price',5,61);
X`09    store_prt_gold;
X`09    display_commands;
X`09    display_inventory(store_num,cur_top);
X`09  end;
X      end;
X
X
X`09`7B Get the ID of a store item and return its value`09-RAK-`09`7D
X`5Bglobal,psect(store$code)`5D function get_store_item(
X`09`09`09`09var com_val`09: integer;
X`09`09`09`09pmt`09 `09: vtype;
X`09`09`09`09i1,i2`09`09: integer) : boolean;
X      var
X`09`09command `09: char;
X`09`09out_val`09`09: vtype;
X`09`09flag`09`09: boolean;
X      begin
X`09com_val := 0;
X`09flag := true;
X`09writev(out_val,'(Items ',chr(i1+96),'-',chr(i2+96),
X`09`09`09`09`09', `5EZ to exit) ',pmt);
X`09while (((com_val < i1) or (com_val > i2)) and (flag)) do
X`09  begin
X`09    prt(out_val,1,1);
X`09    inkey(command);
X`09    com_val := ord(command);
X`09    case com_val of
X`09`093,25,26,27 :`09flag := false;
X`09`09otherwise com_val := com_val - 96;
X`09    end;
X`09  end;
X`09msg_flag := false;
X`09erase_line(msg_line,msg_line);
X`09get_store_item := flag;
X      end;
X
X`5Bglobal,psect(store$code)`5D procedure shut_store(store_num : integer);
X    begin
X      with store`5Bstore_num`5D do
X       begin
X`09with py.misc.cur_age do
X`09  begin
X`09    store_open.year := year;
X`09    store_open.month := month;
X`09    store_open.day := day;
X`09    store_open.hour := hour;
X`09    store_open.secs := secs;
X`09  end;
X`09with store_open do
X`09  begin
X`09    day := day + 1;
X`09    hour := 6;
X`09    secs := randint(400) - 1;
X`09      if (day > 28) then
X`09`09begin
X`09`09  day := 1;
X`09`09  month := month + 1;
X`09`09    if (month > 13) then
X`09`09      begin
X`09`09`09month := 1;
X`09`09`09year := year + 1;
X`09`09      end;
X`09`09end;
X`09  end;
X       end;
X    end;
X
X`09`7B Increase the insult counter and get pissed if too many -RAK-`09`7D
X`5Bglobal,psect(store$code)`5D function increase_insults(store_num : integer
V) : boolean;
X      begin
X`09increase_insults := false;
X`09with store`5Bstore_num`5D do
X`09  begin
X`09    insult_cur := insult_cur + 1;
X`09    if (insult_cur > owners`5Bowner`5D.insult_max) then
X`09      begin
X`09`09prt_comment4;
X`09`09insult_cur := 0;
X`09`09change_rep(-5);
X`09`09shut_store(store_num);
X`09`09increase_insults := true;
X`09      end;
X`09  end;
X      end;
X
X
X`09`7B Decrease insults`09`09`09`09`09-RAK-`09`7D
X`5Bglobal,psect(store$code)`5D procedure decrease_insults(store_num : intege
Vr);
X      begin
X`09with store`5Bstore_num`5D do
X`09  begin
X`09    insult_cur := insult_cur - 2;
X`09    if (insult_cur < 0) then insult_cur := 0;
X`09  end;
X      end;
X
X
X`09`7B Have insulted while haggling`09`09`09`09-RAK-`09`7D
X`5Bglobal,psect(store$code)`5D function haggle_insults(store_num : integer)
V : boolean;
X`09begin
X`09  haggle_insults := false;
X`09  if (increase_insults(store_num)) then
X`09    haggle_insults := true
X`09  else
X`09    prt_comment5;
X`09end;
X
X`5Bglobal,psect(store$code)`5D function receive_offer(
X`09`09`09`09store_num`09`09: integer;
X`09`09`09`09comment `09`09: vtype;
X `09`09`09`09var new_offer `09`09: integer;
X`09`09`09`09last_offer,factor`09: integer) : integer;
X`09var
X`09`09flag`09`09`09`09: boolean;
X
X`09function get_haggle(comment : vtype; var num : integer) : boolean;
X`09  var
X`09`09i1,clen`09`09`09: integer;
X`09`09out_val`09`09`09: vtype;
X`09`09flag`09`09`09: boolean;
X`09  begin
X`09    flag := true;
X`09    i1 := 0;
X`09    clen := length(comment) + 1;
X`09    repeat
X`09      msg_print(comment);
X`09      msg_flag := false;
X`09      if (not(get_string(out_val,1,clen,40))) then
X`09`09begin
X`09          flag := false;
X`09`09  erase_line(msg_line,msg_line);
X`09`09end;
X`09      readv(out_val,i1,error:=continue);
X`09    until((i1 <> 0) or not(flag));
X`09    if (flag) then num := i1;
X`09    get_haggle := flag;
X`09  end;
X
X`09begin
X`09  receive_offer := 0;
X`09  flag := false;
X`09  repeat
X`09    if (get_haggle(comment,new_offer)) then
X`09      begin
X`09        if (new_offer*factor >= last_offer*factor) then`20
X`09          flag := true
X`09        else if (haggle_insults(store_num)) then
X`09`09  begin
X`09`09    receive_offer := 2;
X`09`09    flag := true;
X`09`09  end
X`09      end
X`09    else
X`09      begin
X`09        receive_offer := 1;
X`09        flag := true;
X`09      end;
X`09  until (flag);
X        end;
X
X
X`09`7B Haggling routine`09`09`09`09`09-RAK-`09`7D
X`5Bglobal,psect(store$code)`5D function purchase_haggle(
X`09`09`09`09store_num`09: integer;
X`09`09`09`09var price`09: integer;
X`09`09`09`09item`09`09: treasure_type;
X`09`09`09`09blitz`09`09: boolean) : integer;
X      var
X`09max_sell,min_sell,max_buy`09`09: integer;
X`09cost,cur_ask,final_ask,min_offer`09: integer;
X`09last_offer,new_offer,final_flag,x3`09: integer;
X`09delta`09`09`09`09`09: integer;
X`09x1,x2`09`09`09`09`09: real;
X`09min_per,max_per`09`09`09`09: real;
X`09flag,loop_flag`09`09`09`09: boolean;
X`09out_val,comment`09`09`09`09: vtype;
X
X      begin
X`09flag := false;
X`09purchase_haggle := 0;
X`09price := 0;
X`09final_flag := 0;
X`09msg_flag := false;
X`09with store`5Bstore_num`5D do
X`09  with owners`5Bowner`5D do
X`09    begin
X`09      cost := sell_price(store_num,max_sell,min_sell,item);
X`09      max_sell := max_sell + trunc(max_sell*chr_adj);
X`09      if (max_sell < 0) then max_sell := 1;
X`09      min_sell := min_sell + trunc(min_sell*chr_adj);
X`09      if (min_sell < 0) then min_sell := 1;
X`09      max_buy  := trunc(cost*(1-max_inflate));
X`09      min_per  := haggle_per;
X`09      max_per  := min_per*3.0;
X`09    end;
X`09haggle_commands(1);
X`09cur_ask   := max_sell;
X`09final_ask := min_sell;
X`09min_offer := max_buy;
X`09last_offer := min_offer;
X`09comment := 'Asking : ';
X`09if (blitz) then
X`09  begin
X`09    delta := (max_sell - min_sell);
X`09    last_offer := min_sell + (delta div 4);
X`09    with store`5Bstore_num`5D do
Xprice := last_offer + ((insult_cur * delta) DIV owners`5Bowner`5D.insult_max
V);
X`09    comment := 'In a hurry, eh?  It''s yours for a mere ';
X`09    writev(out_val,comment,price:1);
X`09    msg_print(out_val);
X`09    msg_print(' ');
X`09  end
X`09else `7B go ahead and haggle `7D
X`09repeat
X`09  repeat
X`09    loop_flag := true;
X`09    writev(out_val,comment,cur_ask:1);
X`09    put_buffer(out_val,2,1);
X`09    case receive_offer(store_num,'What do you offer? ',
X`09`09`09     new_offer,last_offer,1) of
X`09      1 : begin
X`09`09    purchase_haggle := 1;
X`09`09    flag   := true;
X`09`09  end;
X`09      2 : begin
X`09`09    purchase_haggle := 2;
X`09`09    flag   := true;
X`09`09  end;
X`09      otherwise if (new_offer > cur_ask) then
X`09`09`09  begin
X`09`09`09    prt_comment6;
X`09`09`09    loop_flag := false;
X`09`09`09  end
X`09`09        else if (new_offer = cur_ask) then
X`09                  begin
X`09`09`09    flag := true;
X`09`09`09    price := new_offer;
X`09`09`09  end;
X`09    end;
X`09  until ((flag) or (loop_flag));
X`09  if (not(flag)) then
X`09    begin
X`09      x1 := (new_offer - last_offer)/(cur_ask - last_offer);
X`09      if (x1 < min_per) then
X`09`09begin
X`09`09  flag := haggle_insults(store_num);
X`09`09  if (flag) then purchase_haggle := 2;
X`09`09end
X`09      else
X`09`09begin
X`09`09  if (x1 > max_per) then`20
X`09`09    begin
X`09`09      x1 := x1*0.75;
X`09`09      if (x1 < max_per) then x1 := max_per;
X`09`09    end;
X`09          x2 := (x1 + (randint(5) - 3)/100.0);
X`09          x3 := trunc((cur_ask-new_offer)*x2) + 1;
X`09`09  cur_ask := cur_ask - x3;
X`09`09  if (cur_ask < final_ask) then
X`09`09    begin
X`09`09      cur_ask := final_ask;
X`09`09      comment := 'Final Offer : ';
X`09`09      final_flag := final_flag + 1;
X`09`09      if (final_flag > 3) then
X`09`09`09begin
X`09`09`09  if (increase_insults(store_num)) then
X`09`09`09    purchase_haggle := 2
X`09`09`09  else
X`09`09`09    purchase_haggle := 1;
X`09`09`09  flag := true;
X`09`09`09end;
X`09`09    end
X`09`09  else if (new_offer >= cur_ask) then
X`09            begin
X`09`09      flag := true;
X`09`09      price := new_offer;
X`09`09    end;
X`09`09  if (not(flag)) then
X`09`09    begin
X`09              last_offer := new_offer;
X`09`09      prt('',2,1);
X`09              writev(out_val,'Your last offer : ',last_offer:1);
X`09              put_buffer(out_val,2,40);
X`09`09      prt_comment2(last_offer,cur_ask,final_flag);
X`09`09    end;
X`09        end;
X`09    end;
X`09until (flag);
X`09prt('',2,1);
X`09display_commands;
X      end;
X
X
X`09`7B Haggling routine`09`09`09`09`09-RAK-`09`7D
X`09`7B Return value shows the result of the haggling:
X`09`090 = Sold, 2 = Aborted, 3 = Owner will not buy `7D
X`5Bglobal,psect(store$code)`5D function sell_haggle(
X`09`09`09`09store_num`09: integer;
X`09`09`09`09var price`09: integer;
X`09`09`09`09item`09`09: treasure_type;
X`09`09`09`09blitz`09`09: boolean) : integer;
X      var
X`09max_sell,max_buy,min_buy`09`09: integer;
X`09cost,cur_ask,final_ask,min_offer`09: integer;
X`09last_offer,new_offer,final_flag,x3`09: integer;
X`09max_gold,delta`09`09`09`09: integer;
X`09x1,x2`09`09`09`09`09: real;
X`09min_per,max_per`09`09`09`09: real;
X`09flag,loop_flag`09`09`09`09: boolean;
X`09comment,out_val`09`09`09`09: vtype;
X`09temp_ptr`09`09`09`09: treas_ptr;
X`09wgt`09`09`09`09`09: integer;
X
X      begin
+-+-+-+-+-+-+-+-  END  OF PART 82 +-+-+-+-+-+-+-+-