-+-+-+-+-+-+-+-+ START OF PART 55 -+-+-+-+-+-+-+-+ 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`5Bpsect(store$code)`5D procedure display_commands; X begin Xprt('You may:',21,1); Xprt(' p) Purchase an item. b) Browse store''s inventory.',22,1); Xprt(' s) Sell an item. i) Inventory and Equipment Lists.',23,1 V); 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`5Bpsect(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 Haggeling.',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`5Bpsect(store$code)`5D procedure display_inventory(store_num,start : intege Vr); 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 inventory`5Binven_max`5D := store_inven`5Bstart`5D.sitem; X`09`09 with inventory`5Binven_max`5D do X`09`09 if ((subval > 255) and (subval < 512)) then X`09`09 number := 1; X`09`09 objdes(out_val1,inven_max,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 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:6); X`09`09 end X`09`09 else X`09`09 writev(out_val2,store_inven`5Bstart`5D.scost:6,' `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`5Bpsect(store$code)`5D procedure display_cost(store_num,pos : integer); 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:6); X`09 end X`09 else X`09 writev(out_val,store_inven`5Bpos`5D.scost:6,' `5BFixed`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`5Bpsect(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.au: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`5Bpsect(store$code)`5D procedure display_store(store_num,cur_top : integer) V; 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 it's value`09-RAK-`09`7D X`5Bpsect(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 X`09`7B Increase the insult counter and get pissed if too many -RAK-`09`7D X`5Bpsect(store$code)`5D function increase_insults(store_num : integer) : boo Vlean; 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`09store_open := turn + 2500 + randint(2500); 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`5Bpsect(store$code)`5D procedure decrease_insults(store_num : integer); 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`5Bpsect(store$code)`5D function haggle_insults(store_num : integer) : boole Van; 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`5Bpsect(store$code)`5D function recieve_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 recieve_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 recieve_offer := 2; X`09`09 flag := true; X`09`09 end X`09 end X`09 else X`09 begin X`09 recieve_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`5Bpsect(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) : 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`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`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 recieve_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`5Bpsect(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) : 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`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 X begin X`09flag := false; X`09sell_haggle := 0; X`09price := 0; X`09final_flag := 0; X`09msg_flag := false; X`09with store`5Bstore_num`5D do X`09 begin X`09 cost := item_value(item); X`09 if (cost < 1) then X`09 begin X`09`09sell_haggle := 3; X`09`09flag := true; X`09 end X`09 else X`09 with owners`5Bowner`5D do X`09 begin X`09`09 cost := cost - trunc(cost*chr_adj) - X`09`09`09 trunc(cost*rgold_adj`5Bowner_race,py.misc.prace`5D); X`09`09 if (cost < 1) then cost := 1; X`09 max_sell := trunc(cost*(1+max_inflate)); X`09 max_buy := trunc(cost*(1-max_inflate)); X`09 min_buy := trunc(cost*(1-min_inflate)); X`09`09 if (min_buy < max_buy) then min_buy := max_buy; X`09 min_per := haggle_per; X`09 max_per := min_per*3.0; X`09`09 max_gold := max_cost; X`09 end; X`09 end; X`09if (not(flag)) then X`09 begin X`09 haggle_commands(-1); X`09 if (max_buy > max_gold) then X`09 begin X`09`09final_flag:= 1; X`09`09comment := 'Final offer : '; X`09 cur_ask := max_gold; X`09`09final_ask := max_gold; Xmsg_print('I am sorry, but I have not the money to afford such a fine item.' V); Xmsg_print(' '); X`09 end X`09 else X`09 begin X`09`09cur_ask := max_buy; X`09 final_ask := min_buy; X`09`09if (final_ask > max_gold) then X`09`09 final_ask := max_gold; X`09 comment := 'Offer : '; X`09 end; X`09 min_offer := max_sell; X`09 last_offer := min_offer; X`09 if (cur_ask < 1) then cur_ask := 1; X`09 repeat 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 recieve_offer(store_num,'What price do you ask? ', X`09`09`09`09 new_offer,last_offer,-1) of X`09 1 : begin X`09`09 sell_haggle := 1; X`09`09 flag := true; X`09`09 end; X`09 2 : begin X`09`09 sell_haggle := 2; X`09`09 flag := true; X`09`09 end; X`09 otherwise if (new_offer < cur_ask) then X`09 begin X`09`09`09`09prt_comment6; X`09`09`09`09loop_flag := false; X`09`09`09 end X`09`09`09 else if (new_offer = cur_ask) then X`09`09`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`09 msg_flag := false; X`09 x1 := (last_offer - new_offer)/(last_offer - cur_ask); X`09 if (x1 < min_per) then X`09`09 begin X`09`09 flag := haggle_insults(store_num); X`09`09 if (flag) then sell_haggle := 2; X`09`09 end X`09 else X`09`09 begin 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((new_offer-cur_ask)*x2) + 1; X`09`09 cur_ask := cur_ask + x3; +-+-+-+-+-+-+-+- END OF PART 55 +-+-+-+-+-+-+-+-