-+-+-+-+-+-+-+-+ START OF PART 63 -+-+-+-+-+-+-+-+ X store_open := 0; X store_ctr := 0; X for i3 := 1 to store_inven_max do X BEGIN X store_inven`5Bi3`5D.sitem := blank_treasure; X store_inven`5Bi3`5D.scost := 0 X END X END X END; `20 X `20 X `20 X`7B Creates an item and inserts it into store's inven `7D X`5Bpsect(store$code)`5D procedure store_create(store_num : integer); X var X i1,tries,cur_pos,dummy : integer; X BEGIN `20 X tries := 0; X popt(cur_pos); X with store`5Bstore_num`5D do X repeat `20 X if (store_num = 7) then X begin X i1 := randint(blk_mkt_max); X t_list`5Bcur_pos`5D := blk_mkt_init`5Bi1`5D; X end X else X begin X i1 := store_choice`5Bstore_num,randint(store$choices)`5D; X t_list`5Bcur_pos`5D := inventory_init`5Bi1`5D; X magic_treasure(cur_pos,obj_town_level) X end; X inventory`5Binven_max`5D := t_list`5Bcur_pos`5D; X if (store_check_num(store_num)) then X with t_list`5Bcur_pos`5D do X if (cost > 0) then `7B Item must be good `7D X if (cost < owners`5Bowner`5D.max_cost) then X BEGIN `20 X store_carry(store_num,dummy); X tries := 10 X END; `20 X tries := tries + 1; X until(tries > 3); X`09do_black_market; X pusht(cur_pos) X END; `20 X`20 X `20 X`7B Initialize and up-keep the store's inventory. `7D X`5Bpsect(store$code)`5D procedure store_maint; X var X i1,i2,dummy : integer; X BEGIN X for i1 := 1 to max_stores do X with store`5Bi1`5D do X BEGIN X insult_cur := 0; X if (store_ctr > store$max_inven) then X for i2 := 1 to (store_ctr-store$max_inven+2) do X store_destroy(i1,randint(store_ctr),false) X else X if (store_ctr < store$min_inven) then X BEGIN X for i2 := 1 to (store$min_inven-store_ctr+2) do X store_create(i1) X END X else X BEGIN X for i2 := 1 to (1+randint(store$turn_around)) do X store_destroy(i1,randint(store_ctr),true); X for i2 := 1 to (1+randint(store$turn_around)) do X store_create(i1) X END X END X END; X `20 $ CALL UNPACK [.SOURCE.INCLUDE]STORE1.INC;1 136415366 $ create 'f' X`7B Comments vary... X Comment one : Finished haggling `7D X`5Bpsect(store$code)`5D procedure prt_comment1; X begin X msg_flag := false; X case randint(14) of X 1 : msg_print('Done!'); X 2 : msg_print('Accepted!'); X 3 : msg_print('Fine...'); X 4 : msg_print('Agreed!'); X 5 : msg_print('Ok...'); X 6 : msg_print('Taken!'); X 7 : msg_print('You drive a hard bargin, but taken...'); X 8 : msg_print('You''ll force me bankrupt, but it''s a deal...'); X 9 : msg_print('Sigh... I''ll take it...'); X 10 : msg_print('My poor sick children may starve, but done!'); X 11 : msg_print('Finally! I accept...'); X 12 : msg_print('Robbed again...'); X 13 : msg_print('A pleasure to do business with you!'); X 14 : msg_print('My spouse shall skin me, but accepted.'); X end; X end; X`20 X`7B %A1 is offer, %A2 is asking... `7D X`5Bpsect(store$code)`5D procedure prt_comment2(offer,asking,final : integer) V; X var X comment : vtype; X begin X if (final > 0) then X case randint(3) of X 1 : comment := '%A2 is my final offer; take it or leave it...'; X 2 : comment := 'I''ll give you no more than %A2.'; X 3 : comment := 'My patience grows thin... %A2 is final.'; X end X else X case randint(16) of X 1 : comment := '%A1 for such a fine item? HA! No less than %A2 V.'; X 2 : comment := '%A1 is an insult! Try %A2 gold pieces...'; X 3 : comment := '%A1??? Thou would rob my poor starving children V?'; X 4 : comment := 'Why I''ll take no less than %A2 gold pieces.'; X 5 : comment := 'Ha! No less than %A2 gold pieces.'; X 6 : comment := 'Thou blackheart! No less than %A2 gold pieces.' V; X 7 : comment := '%A1 is far too little, how about %A2?'; X 8 : comment := 'I paid more than %A1 for it myself, try %A2.'; X 9 : comment := '%A1? Are you mad??? How about %A2 gold pieces? V'; X 10 : comment := 'As scrap this would bring %A1. Try %A2 in gold. V'; X 11 : comment := 'May fleas of a 1000 orcs molest you. I want %A2 V.'; X 12 : comment := 'My mother you can get for %A1, this costs %A2.'; X 13 : comment := 'May your chickens grow lips. I want %A2 in gold V!'; X 14 : comment := 'Sell this for such a pittance. Give me %A2 gold V.'; X 15 : comment := 'May the Balrog find you tasty! %A2 gold pieces? V'; X 16 : comment := 'Your mother was a Troll! %A2 or I''ll tell...'; X end; X insert_num(comment,'%A1',offer,false); X insert_num(comment,'%A2',asking,false); X msg_print(comment); X end; X`20 X`5Bpsect(store$code)`5D procedure prt_comment3(offer,asking,final : integer) V; X var X comment : vtype; X begin X if (final > 0) then X case randint(3) of X 1 : comment := 'I''ll pay no more than %A1; take it or leave it. V'; X 2 : comment := 'You''ll get no more than %A1 from me...'; X 3 : comment := '%A1 and that''s final.'; X end X else X case randint(15) of X 1 : comment := '%A2 for that piece of junk? No more than %A1'; X 2 : comment := 'For %A2 I could own ten of those. Try %A1.'; X 3 : comment := '%A2? NEVER! %A1 is more like it...'; X 4 : comment := 'Let''s be resonable... How about %A1 gold pieces V?'; X 5 : comment := '%A1 gold for that junk, no more...'; X 6 : comment := '%A1 gold pieces and be thankful for it!'; X 7 : comment := '%A1 gold pieces and not a copper more...'; X 8 : comment := '%A2 gold? HA! %A1 is more like it...'; X 9 : comment := 'Try about %A1 gold...'; X 10 : comment := 'I wouldn''t pay %A2 for your children, try %A1.' V; X 11 : comment := '*CHOKE* For that!? Let''s say %A1.'; X 12 : comment := 'How about %A1.'; X 13 : comment := 'That looks war surplus! Say %A1 gold.'; X 14 : comment := 'I''ll buy it as scrap for %A1.'; X 15 : comment := '%A2 is too much, let us say %A1 gold.'; X end; X insert_num(comment,'%A1',offer,false); X insert_num(comment,'%A2',asking,false); X msg_print(comment); X end; X`20 X `7B Kick 'da bum out... `7D X`5Bpsect(store$code)`5D procedure prt_comment4; X begin X msg_flag := false; X case randint(5) of X 1 : begin X msg_print('ENOUGH! Thou hath abused me once too often!'); X msg_print('Out of my place!'); X msg_print(' '); X end; X 2 : begin X msg_print('THAT DOES IT! You shall waste my time no more! V'); X msg_print('out... Out... OUT!!!'); X msg_print(' '); X end; X 3 : begin X msg_print('This is getting no where... I''m going home!') V; X msg_print('Come back tomorrow...'); X msg_print(' '); X end; X 4 : begin X msg_print('BAH! No more shall you insult me!'); X msg_print('Leave my place... Begone!'); X msg_print(' '); X end; X 5 : begin X msg_print('Begone! I have had enough abuse for one day.') V; X msg_print('Come back when thou art richer...'); X msg_print(' '); X end; X end; X msg_flag := false; X end; X`20 X`5Bpsect(store$code)`5D procedure prt_comment5; X begin X case randint(10) of X 1 : msg_print('You will have to do better than that!'); X 2 : msg_print('That''s an insult!'); X 3 : msg_print('Do you wish to do business or not?'); X 4 : msg_print('Hah! Try again...'); X 5 : msg_print('Ridiculus!'); X 6 : msg_print('You''ve got to be kidding!'); X 7 : msg_print('You better be kidding!!'); X 8 : msg_print('You try my patience.'); X 9 : msg_print('I don''t hear you.'); X 10 : msg_print('Hmmm, nice weather we''re having...'); X end; X end; X`20 X`20 X`5Bpsect(store$code)`5D procedure prt_comment6; X begin X case randint(5) of X 1 : msg_print('I must of heard you wrong...'); X 2 : msg_print('What was that?'); X 3 : msg_print('I''m sorry, say that again...'); X 4 : msg_print('What did you say?'); X 5 : msg_print('Sorry, what was that again?'); X end; `20 X end; X`20 X`20 X`7B Displays the set of commands `7D X`5Bpsect(store$code)`5D procedure display_commands(store_num:integer); X begin Xif (store_num = 7) then Xprt('You may: m) Make an item.',21,1) Xelse 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`20 X`20 X `7B Displays the set of commands -RAK- `7 VD X`5Bpsect(store$code)`5D procedure haggle_commands(typ : integer); X begin X clear(21,1); X if (typ = -1) then X prt('Specify an asking-price in gold pieces.',22,1) X else `20 X prt('Specify an offer in gold pieces.',22,1); X prt('`5EZ) Quit Haggeling.',23,1); X prt('',24,1); X end; X`20 X`20 X`7B Displays a store's inventory `7D X`5Bpsect(store$code)`5D procedure display_inventory(store_num,start : intege Vr); X var X i1,i2,stop,dum1,dum2 : integer; X out_val1,out_val2 : vtype; X begin `20 X with store`5Bstore_num`5D do X begin X i1 := ((start-1) mod 12); X stop := (((start-1) div 12) + 1)*12; X if (stop > store_ctr) then stop := store_ctr; X while (start <= stop) do X begin X inventory`5Binven_max`5D := store_inven`5Bstart`5D.sitem; X with inventory`5Binven_max`5D do X if ((subval > 255) and (subval < 512)) then X number := 1; X objdes(out_val1,inven_max,true); 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_adj); X writev(out_val2,i2:7); X end X else X writev(out_val2,store_inven`5Bstart`5D.scost:7,' `5BFixe Vd`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_adj); X writev(out_val,i2:7); X end X else X writev(out_val,store_inven`5Bpos`5D.scost:7,' `5BFixed`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,'Gold Remaining : ',py.misc.au:1); X prt(out_val,19,18); 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`5Bowner`5D.owner_name,4,10); X prt(' Item',5,1); X prt('Asking Price',5,61); X store_prt_gold; `20 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; +-+-+-+-+-+-+-+- END OF PART 63 +-+-+-+-+-+-+-+-