-+-+-+-+-+-+-+-+ START OF PART 71 -+-+-+-+-+-+-+-+ X number := 1; X objdes(out_val1,1,true,'t'); X writev(out_val2,chr(97+i1),') ',out_val1); X prt(out_val2,i1+6,1); X if (store_inven`5Bstart`5D.scost < 0) then X begin X i2 := abs(store_inven`5Bstart`5D.scost); X i2 := i2 + trunc(i2*chr_padj); X writev(out_val2,i2:7); X end X else X writev(out_val2,store_inven`5Bstart`5D.scost:7,' `5BSale V`5D'); X prt(out_val2,i1+6,60); X i1 := i1 + 1; X start := start + 1; X end; X if (i1 < 12) then X for i2 := 1 to (12 - i1 + 1) do X prt('',i2+i1+5,1); X end; X end; X`20 X`20 X `7B Re-displays only a single cost -RAK- `7 VD X`5Bpsect(store$code)`5D procedure display_cost(store_num,pos : integer); X var X i1 : integer; X out_val : vtype; X begin X with store`5Bstore_num`5D do X begin X i1 := ((pos-1) mod 12); X if (store_inven`5Bpos`5D.scost < 0) then X begin X i2 := abs(store_inven`5Bpos`5D.scost); X i2 := i2 + trunc(i2*chr_padj); X writev(out_val,i2:7); X end X else X writev(out_val,store_inven`5Bpos`5D.scost:7,' `5BSale`5D'); X prt(out_val,i1+6,60); X end; X end; X`20 X`20 X `7B Displays players gold -RAK- `7 VD X`5Bpsect(store$code)`5D procedure store_prt_gold; X var X out_val : vtype; X begin X writev(out_val,'Dollars Remaining : ',py.misc.au:1); X prt(out_val,19,20); X end; X`20 X`20 X `7B Displays store -RAK- `7 VD X`5Bpsect(store$code)`5D procedure display_store(store_num,cur_top : integer) V; X begin X with store`5Bstore_num`5D do X begin X clear(1,1); X prt(owners`5Bstore_num,town_num`5D.owner_name,3,10); X prt(' Item',5,1); X prt('Today''s Price',5,60); X store_prt_gold; X display_commands(store_num); X display_inventory(store_num,cur_top); X end; X end; X`20 X`20 X `7B Get the ID of a store item and return it's value -RAK- `7 VD X`5Bpsect(store$code)`5D function get_store_item( X var com_val : integer; X pmt : vtype; X i1,i2 : integer) : boolean; X var X command : char; X out_val : vtype; X flag : boolean; X begin X com_val := 0; X flag := true; X writev(out_val,'(Items ',chr(i1+96),'-',chr(i2+96), X ', `5EZ to exit) ',pmt); X while (((com_val < i1) or (com_val > i2)) and (flag)) do X begin X prt(out_val,1,1); X inkey(command); X com_val := ord(command); X case com_val of X 3,25,26,27 : flag := false; X otherwise com_val := com_val - 96; X end; X end; X msg_flag := false; X erase_line(msg_line,msg_line); X get_store_item := flag; X end; X`20 X `7B Returns the char inven position of a coupon`7D`20 X`5Bpsect(store$code)`5D function get_coupon(store_num : integer; X`09`09`09`09`09var coup_val : integer; X`09`09`09`09`09cur_top`09 : integer) : boolean; X var X `09i2,i3`09 : integer; X`09redraw`09 : boolean; X`20 XBEGIN X redraw := false; X get_coupon := false; X if (not(find_range(`5B3`5D,i2,i3))) then X msg_print('You don''t have any coupons.') X else`20 X if (get_item(coup_val,'Use which coupon?',redraw,i2,i3)) then X begin X if (redraw) then display_store(store_num,cur_top); X`09with inventory`5Bcoup_val`5D do X`09 if ((subval = store_num) or (subval = 20)) then`20 X`09 get_coupon := true X`09 else X`09 msg_print('I cannot accept that!'); X end; XEND; X`20 X`20 X`7B Returns whether a sale has been made and the selling price`7D X`7B0- sale , 2- no sale , 3- player tryed to sell valueless item`7D X`5Bpsect(store$code)`5D function ask_price( X store_num : integer; X `09`09`09 var price : integer; X item : treasure_type) : integer; X var X cost `09 `09: integer; X`09accept`09`09: char;`20 X`20 X BEGIN X ask_price := 0; X price := 0; X msg_flag := false; X with store`5Bstore_num`5D do X Begin X cost := item_value(item); X If (cost < 1) then X ask_price := 3 X Else X with owners`5Bstore_num,town_num`5D do X begin X`09 cost := cost - trunc(cost*chr_padj) - X trunc(cost*rgold_adj`5Bowner_class,py.misc.pclass`5 VD); X`09 cost := trunc(cost*(1-sell_deflate)); X if (cost < 1) then cost := 1; X`09`09price := cost; X`09`09prt_num('Hmmmm, that''s worth: ',price,2,2); X`09`09msg_print(''); X`09`09if (get_com('Accept the Offer? (y/n)',accept)) then X if (accept = 'y') then `20 X ask_price := 0 X`09`09 else X ask_price := 2 X`09 else ask_price := 2; X prt('',2,1); X end; X End; X END; X`20 X`20 X `7B Buy an item from a store -RAK- `7 VD X`5Bpsect(store$code)`5D function store_purchase( X`09`09`09 `09 store_num : integer; X`09`09`09`09 coupon`09 : boolean; X`09`09`09`09 coup_val`09 : integer; X`09`09`09 `09 var cur_top : integer) : boolean; X var X i1,item_val,price`09 : integer; X item_new,choice : integer; X save_number : integer; X`09per_off`09`09`09`09`09: real; X out_val : vtype; X XBEGIN X store_purchase := false; X with store`5Bstore_num`5D do X Begin X `7B i1 = number of objects shown on screen `7D X if (cur_top = 13) then X i1 := store_ctr - 12 X else if (store_ctr > 12) then X i1 := 12 X else X i1 := store_ctr; X If (store_ctr < 1) then X msg_print('I am currently out of stock.') X `7Bget coupon value`7D X Else if (get_store_item(item_val,`09`09`7BGet the store item number`7D X 'Which item are you interested in? ',1,i1)) then X X begin X item_val := item_val + cur_top - 1; `7B true item_val `7 VD X temporary_slot := store_inven`5Bitem_val`5D.sitem; X`09`09price := abs(store_inven`5Bitem_val`5D.scost); X`09`09price := price + trunc(price*chr_padj); X`09`09if (coupon) then`20 X`09`09 begin X`09`09 per_off := (100 - inventory`5Bcoup_val`5D.p1)/100; X`09`09 price := trunc(price*per_off); X`09`09 inven_destroy(coup_val);`09`09 `20 X`09`09 end; X`09`09if (price < 1) then price := 1; X with temporary_slot do X if ((subval > 255) and (subval < 512)) then X begin X save_number := number; X number := 1; X end X else X save_number := 1; X if (inven_check_weight) then X if (inven_check_num) then X begin X`09`09 if (wizard) then X`09`09 py.misc.au := py.misc.au + price; X if (py.misc.au < price) then X msg_print('You Scum! Cough up more dough!') X else X Begin X`09`09`09 if (coupon) then`20 X prt_comment2(price) X`09`09`09 else X prt_comment1; X py.misc.au := py.misc.au - price; X store_destroy(store_num,item_val,true); X inven_carry(item_new); X objdes(out_val,item_new,true,'i'); X out_val := 'You have ' + out_val + ' (' + chr(item_new+96) + ')'; X msg_print(out_val); X if (cur_top > store_ctr) then X begin X cur_top := 1; X display_inventory(store_num,cur_top); X end X else X with store_inven`5Bitem_val`5D do X`09`09`09 begin X`09`09`09 display_inventory(store_num,item_val); X store_prt_gold; X end; X End; X prt('',2,1); X end X else X prt('You cannot carry that many different items.',1,1) X else X prt('You can not carry that much weight.',1,1); X end; X end; X END; X`20 X`20 X`7B Sell an item to the store `7D X`5Bpsect(store$code)`5D function store_sell(store_num,cur_top : integer) X`09`09`09`09`09`09: boolean; X var X item_val,i1, X item_pos,price : integer; X redraw : boolean; X out_val : vtype; X begin X store_sell := false; X with store`5Bstore_num`5D do X begin X redraw := false; X if (get_item(item_val,'Sell which item?',redraw,1,inven_ctr)) then X begin X if (redraw) then display_store(store_num,cur_top); X temporary_slot := inventory`5Bitem_val`5D; X with temporary_slot do X if ((subval > 255) and (subval < 512)) then X number := 1; X objdes(out_val,1,true,'t'); X out_val := 'Selling ' +out_val+ ' (' + chr(item_val+96) + ') V'; X msg_print(out_val); X msg_print(' '); X if (temporary_slot.tval in store_buy`5Bstore_num`5D) then X if (store_check_num(store_num)) then X case ask_price(store_num,price,temporary_slot) of X 0 : begin X prt_comment1; X py.misc.au := py.misc.au + price; X inven_destroy(item_val); X store_carry(store_num,item_pos); X if (item_pos > 0) then X if (item_pos < 13) then X if (cur_top < 13) then X display_inventory(store_num,item_pos) X else X display_inventory(store_num,cur_top) X else if (cur_top > 12) then X display_inventory(store_num,item_pos); X store_prt_gold; X end; X 2 : store_sell := true; X 3 : begin X msg_print('How dare you!'); X msg_print('I will not buy that!'); X end; X otherwise ; X end X else X prt('I have not the room in my store to keep it...',1,1) X else X prt('I do not buy such items.',1,1); X end X else if (redraw) then X display_store(store_num,cur_top); X end; X end; X`20 X`20 X`7B Entering a store `7D X`5Bpsect(store$code)`5D procedure enter_store(store_num : integer); X var X com_val,cur_top,coup_val,dummy : integer; X command : char; X exit_flag,coupon`09`09: boolean;`20 X`20 X BEGIN X dummy := 1; X coupon := false; X with store`5Bstore_num`5D do X if (store_num = 7) and (py.misc.au < 500) then X msg_print('The bouncer says that you''re too poor to enter.') X X else if (((store_open > day) or (turn > 12960) or (turn < 4320))`2 V0 X`09`09`09 and (store_num <> 7)) then X`09 msg_print('The doors are locked.') X X`09 else X Begin X exit_flag := false; X cur_top := 1; X display_store(store_num,cur_top); X repeat X if (get_com('',command)) then X begin X msg_flag := false; X com_val := ord(command); X case com_val of X 18 : display_store(store_num,cur_top); X`09`09 20 : begin `7Bspecific training`7D X`09`09`09`09 training(store_num); X`09`09`09`09 exit_flag := true; X`09`09`09`09end; X 32 : begin `7Bbrowse inventory`7D X if (cur_top = 1) then X if (store_ctr > 12) then X begin X cur_top := 13; X display_inventory(store_num,cur_top) V; X end X else X prt('Entire inventory is shown.',1,1) X else X begin X cur_top := 1; X display_inventory(store_num,cur_top); X end X end; X 101 : begin `7B Equipment List `7D X if (inven_command('e',0,0)) then X display_store(store_num,cur_top); X end; +-+-+-+-+-+-+-+- END OF PART 71 +-+-+-+-+-+-+-+-