-+-+-+-+-+-+-+-+ START OF PART 70 -+-+-+-+-+-+-+-+ X`09`09 else`20 X`09`09 `7Barmors`7D X item_value := (cost+(tohit+toac)*100)*number X END X else X item_value := (cost+toac*100)*number X END X else if (tval in `5B9,10,11,12,13,82,84`5D) then X BEGIN `7B Ammo, Spikes, Thrown and Grenades `7D X if (index(name,'`5E') > 0) then X item_value := search_list(tval,1)*number X else X item_value := (cost+(tohit+todam+toac)*10)*number X END X else if (tval in `5B70,71,75,76,80`5D) then X BEGIN `7B Potions, Scrolls, and Food `7D X if (index(name,'`7C') > 0) then X case tval of X 70,71 : item_value := 20; X 75,76 : item_value := 20; X 80 : item_value := 1; X otherwise X END X END X else if (tval in `5B40,45`5D) then X BEGIN `7B Rings and amulets `7D X if (index(name,'`7C') > 0) then X case tval of X 40 : item_value := 45; X 45 : item_value := 45; X otherwise X END X else if (index(name,'`5E') > 0) then X item_value := abs(cost); X END X else if (tval in `5B55,60,65`5D) then X BEGIN `7B Wands rods, and staves`7D X if (index(name,'`7C') > 0) then X case tval of X 55 : item_value := 70; X 60 : item_value := 60; X 65 : item_value := 50; X otherwise ; X END X else if (index(name,'`5E') = 0) then X BEGIN X item_value := cost + trunc(cost/20.0)*p1 X END X END X END X END; X`20 X`20 X`7B Asking price for an item `7D`20 X`5Bpsect(store$code)`5D function sell_price (snum : integer; X item : treasure_type ) : integer; X var X i1 : integer; XBEGIN X with store`5Bsnum`5D do `20 X BEGIN X i1 := item_value(item); X if (item.cost > 0) then X`09 with owners`5Bsnum,town_num`5D do X begin `20 X i1 := i1 + trunc(i1*rgold_adj`5Bowner_class,py.misc.pclass V`5D); X i1 := i1 + trunc(i1*(buy_inflate)); X if (i1 < 1) then i1 := 1; X sell_price := i1 X end `20 X else X sell_price := 0 X END; XEND; X`20 X`20 X`7B Check to see if he will be carrying too many objects `7D X`5Bpsect(store$code)`5D function store_check_num(store_num : integer) : bool Vean; X var `20 X item_num,i1 : integer; X flag : boolean; X BEGIN X store_check_num := false; X with store`5Bstore_num`5D do X if (store_ctr < store_inven_max) then X store_check_num := true X else X if ((temporary_slot.subval > 255) and X (temporary_slot.subval < 512)) then X for i1 := 1 to store_ctr do X with store_inven`5Bi1`5D.sitem do X if (tval = temporary_slot.tval) then X if (subval = temporary_slot.subval) then X store_check_num := true X END; X `20 X `20 X`7B Add the item in TEMPORARY_SLOT to store's inventory. `7D X `5Bpsect(store$code)`5D procedure store_carry( store_num : integer; X var ipos : integer); X var X item_num,item_val,typ,subt,icost,dummy : integer; X flag : boolean; X `20 X`7B Insert TEMPORARY_SLOT at given location `7D X procedure insert(store_num,pos,icost : integer); X var X i1 : integer; X BEGIN X with store`5Bstore_num`5D do X BEGIN X for i1 := store_ctr downto pos do X store_inven`5Bi1+1`5D := store_inven`5Bi1`5D; X store_inven`5Bpos`5D.sitem := temporary_slot; X store_inven`5Bpos`5D.scost := -icost; X store_ctr := store_ctr + 1 X END X END; X `20 X`7B Store_carry routine `7D X BEGIN X ipos := 0; X identify(temporary_slot); X`09unquote(temporary_slot.name); X`09known1(temporary_slot.name); X known2(temporary_slot.name); X icost := sell_price(store_num,temporary_slot); X if (icost > 0) then X BEGIN X with temporary_slot do X with store`5Bstore_num`5D do X BEGIN X item_val := 0; X item_num := number; X flag := false; X typ := tval; X subt := subval; X repeat X item_val := item_val + 1; X with store_inven`5Bitem_val`5D.sitem do X if (typ = tval) then X BEGIN X if (subt = subval) then`7B Adds to other item `7 VD X if (subt > 255) then X BEGIN X if (number < 24) then X number := number + item_num; X flag := true X END X END X else if (typ > tval) then X BEGIN `7B Insert into list `7D X insert(store_num,item_val,icost); X flag := true; X ipos := item_val X END; X until ((item_val >= store_ctr) or (flag)); X if (not(flag)) then `7B Becomes last item in list `7D X BEGIN X insert(store_num,store_ctr+1,icost); X ipos := store_ctr X END X END X END X END; `20 X`20 X`20 X`20 X`7B Destroy an item in the store's inventory. Note that if 'one_of' is fals Ve, X an entire slot is destroyed `7D X`5Bpsect(store$code)`5D procedure store_destroy(store_num,item_val : integer V; X one_of : boolean); X var X i2 : integer; X BEGIN `20 X with store`5Bstore_num`5D do X BEGIN X temporary_slot := store_inven`5Bitem_val`5D.sitem; X with store_inven`5Bitem_val`5D.sitem do X BEGIN X if ((number > 1) and (subval < 512) and (one_of)) then X BEGIN X number := number - 1; X temporary_slot.number := 1 X END X else X BEGIN X for i2 := item_val to store_ctr-1 do X store_inven`5Bi2`5D := store_inven`5Bi2+1`5D; X store_inven`5Bstore_ctr`5D.sitem := blank_treasure; X store_inven`5Bstore_ctr`5D.scost := 0; X store_ctr := store_ctr - 1 X END X END X END X END; X`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,dummy : integer; X BEGIN `20 X tries := 0; X with store`5Bstore_num`5D do X repeat `20 X i1 := store_choice`5Bstore_num,randint(store$choices)`5D; X temporary_slot := inventory_init`5Bi1`5D; X magic_treasure(temporary_slot,obj_town_level); X if (store_check_num(store_num)) then X with temporary_slot do X if (cost > 0) then `7B Item must be good `7D X BEGIN `20 X store_carry(store_num,dummy); X tries := 10 X END; `20 X tries := tries + 1; X until(tries > 3); X END; `20 X X `7BAdd Black Market items to the inventory`7D X`5Bpsect(store$code)`5D procedure do_black_market; Xvar X indx,iptr,inven_num : integer; X XBEGIN X inven_num := 0; X store`5B7`5D.store_ctr := 0; X while (inven_num < store_inven_max) do X inven_num := 5 + randint(store_inven_max); X if (inven_num > store_inven_max) then inven_num := store_inven_max; X for indx := 1 to inven_num do X with store`5B7`5D.store_inven`5Bindx`5D do X BEGIN X`09 repeat X iptr := randint(inven_init_max); X`09 temporary_slot := inventory_init`5Biptr`5D; X`09 magic_treasure(temporary_slot,999); `7Bspecial black magic`7D X`09 until(temporary_slot.cost > 500); X store_carry(7,iptr); X END; X for indx := inven_num to store_inven_max do X with store`5B7`5D.store_inven`5Bindx`5D do X sitem := blank_treasure; X store`5B7`5D.store_ctr := store`5B7`5D.store_ctr - 1; XEND; X`20 X `20 X`7B Rotate stock, create sales, and up-keep the store's inventory. `7D X`7B Remember Doofus, that this procedure only works when there's a `7D X`7B dungeon floor in existance.`7D X`5Bpsect(store$code)`5D procedure store_maint; X var X i1,i2,i3,i4`09: integer; X X BEGIN X do_black_market; X for i1 := 1 to max_stores do X if (i1 <> 7) then`09`20 X with store`5Bi1`5D do X BEGIN X`7Bsale`7D`09 for i3 := 1 to store_ctr do X`09 begin X `09 if (randint(10) = 1) then`20 X`09`09 begin X`09`09 with store_inven`5Bi3`5D do X`09`09 i4 := abs(trunc(store_inven`5Bi3`5D.scost*sale_val)); X`09`09 if (i4 < 1) then i4 := 1; X`09`09 store_inven`5Bi3`5D.scost := i4;`20 X`09`09 store_inven`5Bi3`5D.sitem.cost := i4; X`09`09 end; X`09`09end; X`7BMaint.`7D 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 X `20 X`7B Initializes the town stores with inventory `7D X`5Bpsect(store$code)`5D procedure store_init; X var X i2,i3 : integer; X BEGIN X for i2 := 1 to max_stores do X with store`5Bi2`5D do X Begin `7Bowner is now a dummy value`7D X owner := 0; insult_cur := 0; store_open := 0; 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 X X $ CALL UNPACK [.INC]STORE1.INC;1 1478387565 $ create 'f' X`7B Comment one : Item is sold.`7D X`5Bpsect(store$code)`5D procedure prt_comment1; X begin X msg_flag := false; X case randint(12) 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('Sold!'); X 7 : msg_print('You''ll force me to bankrupt...'); X 8 : msg_print('Sigh...'); X 9 : msg_print('My poor sick children may starve...'); X 10 : msg_print('Robbed again...'); X 11 : msg_print('A pleasure to do business with you!'); X 12 : msg_print('My spouse shall skin me...'); X end; X end;`20 X X`7B Comment two : Item is sold with a coupon - RLG.`7D X`5Bpsect(store$code)`5D procedure prt_comment2(cash : integer); X VAR X str`09: vtype; `09`09 `20 X X BEGIN X msg_flag := false; X case randint(5) of X 1 : writev(str,'Done! For the low, low price of $',cash:1); X 2 : writev(str,'Sold! For the extra cheap price of $',cash:1); X 3 : writev(str,'Congrats. El Cheapo price, $',cash:1); X 4 : writev(str,'Agreed! LOW PRICE: $',cash:1); X 5 : writev(str,'Ok... You got away with it for only $',cash:1); X end; X`09msg_print(str); X END; X X`7B Displays the set of commands `7D X`5Bpsect(store$code)`5D procedure display_commands(store_num:integer); X begin Xprt('You may:',20,3); Xprt(' p) Purchase an Item. space) Browse store''s inventory.',21,3); Xprt(' s) Sell an Item i) Inventory and Equipment Lists.',22, V3); Xprt(' u) Use a Coupon. `5ER) Redraw the screen.',23,3); Xprt('`5EZ) Exit from Building. `5ET) Seek Special Training.',24,3); 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 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 temporary_slot := store_inven`5Bstart`5D.sitem; X with temporary_slot do X if ((subval > 255) and (subval < 512)) then +-+-+-+-+-+-+-+- END OF PART 70 +-+-+-+-+-+-+-+-