-+-+-+-+-+-+-+-+ START OF PART 56 -+-+-+-+-+-+-+-+ 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; 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`09 begin X`09`09`09 if (increase_insults(store_num)) then X`09`09`09 sell_haggle := 2 X`09`09`09 else X`09`09`09 sell_haggle := 1; X`09`09`09 flag := true; X`09`09`09 end; X`09`09 end X`09`09 else if (new_offer <= cur_ask) then X`09`09`09begin X`09`09`09 flag := true; X`09`09`09 price := new_offer; X`09`09`09end; X 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 bid : ',last_offer:1); X`09 put_buffer(out_val,2,40); X`09`09`09 prt_comment3(cur_ask,last_offer,final_flag); X`09`09 end; X`09 end; X`09 end; X`09 until (flag); X`09 prt('',2,1); X`09 display_commands; X`09 end; X end; X X X`09`7B Buy an item from a store`09`09`09`09-RAK-`09`7D X`5Bpsect(store$code)`5D function store_purchase( X`09`09`09store_num `09: integer; X`09`09`09var cur_top `09: integer) : boolean; X var X`09i1,item_val,price`09`09`09: integer; X`09item_new,choice`09`09`09`09: integer; X`09save_number`09`09`09`09: integer; X`09out_val`09`09`09`09`09: vtype; X begin X`09store_purchase := false; X`09with store`5Bstore_num`5D do X`09 begin X`09`09`7B i1 = number of objects shown on screen`09`7D X`09 if (cur_top = 13) then X`09 i1 := store_ctr - 12 X`09 else if (store_ctr > 12) then X`09 i1 := 12 X`09 else X`09 i1 := store_ctr; X`09 if (store_ctr < 1) then X`09 msg_print('I am currently out of stock.') X`09`09`7B Get the item number to be bought`09`09`7D X`09 else if (get_store_item(item_val, X`09`09`09'Which item are you interested in? ',1,i1)) then X`09 begin X`09`09item_val := item_val + cur_top - 1;`09`7B true item_val`09`7D X`09`09inventory`5Binven_max`5D := store_inven`5Bitem_val`5D.sitem; X`09`09with inventory`5Binven_max`5D do X`09`09 if ((subval > 255) and (subval < 512)) then X`09`09 begin X`09`09 save_number := number; X`09`09 number := 1; X`09`09 end X`09`09 else X`09`09 save_number := 1; X`09`09if (inven_check_weight) then X`09`09 if (inven_check_num) then X`09`09 begin X`09`09 if (store_inven`5Bitem_val`5D.scost > 0) then X`09`09`09begin X`09`09`09 price := store_inven`5Bitem_val`5D.scost; X`09`09`09 choice := 0; X`09`09`09end X`09`09 else X`09choice := purchase_haggle(store_num,price,inventory`5Binven_max`5D); X`09`09 case choice of X`09`09`090 : begin X`09`09`09 if (py.misc.au >= price) then X`09`09`09`09begin X`09`09`09`09 prt_comment1; X`09`09`09`09 decrease_insults(store_num); X`09`09`09`09 py.misc.au := py.misc.au - price; X`09`09`09`09 store_destroy(store_num,item_val,true); X`09`09`09`09 inven_carry(item_new); X`09`09`09`09 objdes(out_val,item_new,true); X`09out_val := 'You have ' + out_val + ' (' + chr(item_new+96) + ')'; X`09`09`09`09 msg_print(out_val); X`09`09`09`09 if (cur_top > store_ctr) then X`09`09`09`09 begin X`09`09`09`09 cur_top := 1; X`09`09`09`09 display_inventory(store_num,cur_top); X`09`09`09`09 end X`09`09`09`09 else X`09`09`09`09 with store_inven`5Bitem_val`5D do X`09`09`09`09 if (save_number > 1) then X`09`09`09`09 begin X`09`09`09`09`09 if (scost < 0) then X`09`09`09`09`09 begin X`09`09`09`09 scost := price; X`09`09`09`09`09 display_cost(store_num,item_val); X`09`09`09`09`09 end; X`09`09`09`09 end X`09`09`09`09 else X`09`09`09`09 display_inventory(store_num,item_val); X`09`09`09`09 store_prt_gold; X`09`09`09`09end X`09`09`09 else X`09`09`09`09begin X`09`09`09`09 if (increase_insults(store_num)) then X`09`09`09`09 store_purchase := true X`09`09`09`09 else X`09`09`09`09 begin X`09`09`09`09prt_comment1; X`09`09`09`09msg_print('Liar! You have not the gold!'); X`09`09`09`09 end; X`09`09`09`09end X`09`09`09 end; X`09`09`092 : store_purchase := true; X`09`09`09otherwise ; X`09`09 end; X`09`09 prt('',2,1); X`09`09 end X`09`09 else X`09`09 prt('You cannot carry that many different items.',1,1) X`09`09else X`09`09 prt('You can not carry that much weight.',1,1); X`09 end; X`09 end; X end; X X X`09`7B Sell an item to the store`09`09`09`09-RAK-`09`7D X`5Bpsect(store$code)`5D function store_sell(store_num,cur_top : integer) : b Voolean; X var X`09item_val,i1`09`09`09: integer; X`09item_pos,price`09`09`09: integer; X`09redraw`09`09`09`09: boolean; X`09out_val`09`09`09`09: vtype; X begin X`09store_sell := false; X`09with store`5Bstore_num`5D do X`09 begin X`09 redraw := false; X`09 if (get_item(item_val,'Which one? ',redraw,1,inven_ctr)) then X`09 begin X`09`09if (redraw) then display_store(store_num,cur_top); X`09`09inventory`5Binven_max`5D := inventory`5Bitem_val`5D; X`09`09with inventory`5Binven_max`5D do X`09`09 if ((subval > 255) and (subval < 512)) then X`09`09 number := 1; X`09`09objdes(out_val,inven_max,true); X`09`09out_val := 'Selling ' +out_val+ ' (' + chr(item_val+96) + ')'; X`09`09msg_print(out_val); X`09`09msg_print(' '); X`09`09if (inventory`5Binven_max`5D.tval in store_buy`5Bstore_num`5D) then X`09`09 if (store_check_num(store_num)) then X`09`09 case sell_haggle(store_num,price,inventory`5Binven_max`5D) of X`09`09 0 : begin X`09`09 prt_comment1; X`09`09`09 py.misc.au := py.misc.au + price; X`09`09 inven_destroy(item_val); X`09`09 store_carry(store_num,item_pos); X`09`09`09 if (item_pos > 0) then X`09`09`09 if (item_pos < 13) then X`09`09`09 if (cur_top < 13) then X`09`09`09`09 display_inventory(store_num,item_pos) X`09`09`09 else X`09`09`09`09 display_inventory(store_num,cur_top) X`09`09`09 else if (cur_top > 12) then X`09`09`09 display_inventory(store_num,item_pos); X`09`09`09 store_prt_gold; X`09`09`09 end; X`09`09 2 : store_sell := true; X`09`09 3 : begin X`09`09`09 msg_print('How dare you!'); X`09`09`09 msg_print('I will not buy that!'); X`09`09`09 store_sell := increase_insults(store_num); X`09`09 end; X`09`09 otherwise ; X`09`09 end X`09`09 else X`09`09 prt('I have not the room in my store to keep it...',1,1) X`09`09else X`09`09 prt('I do not buy such items.',1,1); X`09 end X`09 else if (redraw) then X`09 display_store(store_num,cur_top); X`09 end; X end; X X X`09`7B Entering a store`09`09`09`09`09-RAK-`09`7D X`5Bpsect(store$code)`5D procedure enter_store(store_num : integer); X var X`09com_val,cur_top`09`09`09: integer; X`09command`09`09`09`09: char; X`09exit_flag`09`09`09: boolean; X begin X`09with store`5Bstore_num`5D do X`09 if (store_open < turn) then X`09 begin X`09 exit_flag := false; X`09 cur_top := 1; X`09 display_store(store_num,cur_top); X`09 repeat X`09`09if (get_com('',command)) then X`09`09 begin X`09`09 msg_flag := false; X`09`09 com_val := ord(command); X`09`09 case com_val of X`09`09 18 : display_store(store_num,cur_top); X`09`09 98 : begin X`09`09`09`09 if (cur_top = 1) then X`09`09`09`09 if (store_ctr > 12) then X`09`09`09`09 begin X`09`09`09`09 cur_top := 13; X`09`09`09`09`09display_inventory(store_num,cur_top); X`09`09`09`09 end X`09`09`09`09 else X`09`09`09`09 prt('Entire inventory is shown.',1,1) X`09`09`09`09 else X`09`09`09`09 begin X`09`09`09`09 cur_top := 1; X`09`09`09`09 display_inventory(store_num,cur_top); X`09`09`09`09 end X`09`09`09`09end; X`09`09 101 : begin`09`7B Equipment List`09`7D X`09`09`09`09 if (inven_command('e',0,0)) then X`09`09`09`09 display_store(store_num,cur_top); X`09`09`09`09end; X`09`09 105 : begin`09`7B Inventory`09`09`7D X`09`09`09`09 if (inven_command('i',0,0)) then X`09`09`09`09 display_store(store_num,cur_top); X`09`09`09`09end; X`09`09 116 : begin`09`7B Take off`09`09`7D X`09`09`09`09 if (inven_command('t',0,0)) then X`09`09`09`09 display_store(store_num,cur_top); X`09`09`09`09end; X`09`09 119 : begin`09`7B Wear`09`09`09`7D X`09`09`09`09 if (inven_command('w',0,0)) then X`09`09`09`09 display_store(store_num,cur_top); X`09`09`09`09end; X`09`09 120 : begin`09`7B Switch weapon`09`09`7D X`09`09`09`09 if (inven_command('x',0,0)) then X`09`09`09`09 display_store(store_num,cur_top); X`09`09`09`09end; X`09`09 112 : exit_flag := store_purchase(store_num,cur_top); X`09`09 115 : exit_flag := store_sell(store_num,cur_top); X`09`09 otherwise prt('Invalid Command.',1,1); X`09`09 end; X`09`09 end X`09`09else X`09`09 exit_flag := true; X`09 until(exit_flag); X`09 draw_cave; X`09 end X`09 else X`09 msg_print('The doors are locked.'); X end; $ CALL UNPACK [.SOURCE.INCLUDE]STORE2.INC;1 184605381 $ create 'f' X type X`09byteint`09`09= `5Bbyte`5D 0..255; X`09bytlint`09`09= `5Bbyte`5D -128..127; X`09wordint`09`09= `5Bword`5D 0..65535; X`09worlint`09`09= `5Bword`5D -32768..32767; X`09quad_type`09= record X`09`09`09 l0`09: unsigned; X`09`09`09 l1 : unsigned; X`09`09`09 end; X`09atype`09`09= varying `5B16`5D of char; X`09btype`09`09= varying `5B14`5D of char; X`09ctype`09`09= varying `5B26`5D of char; X`09dtype`09`09= varying `5B5`5D of char; X`09etype`09`09= varying `5B34`5D of char; X`09mtype`09`09= varying `5B190`5D of char; X`09ntype`09`09= varying`5B1024`5D of char; X`09ttype`09`09= varying `5B68`5D of char; X`09vtype`09`09= varying `5B80`5D of char; X`09stat_type`09= packed array `5B1..6`5D of char; X`09obj_set`09`09= set of 0..255; X`09char_set`09= set of 'A'..'z'; X`09key_type`09= record`09`09`7B For char saver`09`7D X`09`09file_id : `5Bkey(0)`5D packed array `5B1..70`5D of char; X`09`09seed`09: integer; X`09end; X`09creature_type = record X`09`09name`09: ctype;`09`7B Descrip of creature`09`7D X`09`09cmove`09: unsigned;`09`7B Bit field`09`09`7D X`09`09spells`09: unsigned;`09`7B Creature spells`09`7D X`09`09cdefense: wordint;`09`7B Bit field`09`09`7D X`09`09sleep`09: worlint;`09`7B Inactive counter`09`7D X`09`09mexp`09: wordint; `09`7B Exp value for kill`09`7D X`09`09aaf`09: byteint;`09`7B Area affect radius`09`7D X`09`09ac`09: byteint;`09`7B AC`09`09`09`7D X`09`09speed`09: bytlint;`09`7B Movement speed`09`7D X`09`09cchar`09: char;`09`09`7B Character rep.`09`7D X`09`09hd`09: dtype;`09`7B Creatures hit die`09`7D X`09`09damage`09: etype;`09`7B Type attack and damage`7D X`09`09level`09: byteint;`09`7B Level of creature`09`7D X`09end; X`09monster_type = record X`09`09hp`09: worlint;`09`7B Hit points`09`09`7D X`09`09csleep`09: worlint;`09`7B Inactive counter`09`7D X`09`09cdis`09: worlint;`09`7B Cur dis from player`09`7D X`09`09mptr`09: wordint;`09`7B Pointer into creature`09`7D X`09`09nptr`09: wordint;`09`7B Pointer to next block`09`7D X`09`09cspeed`09: bytlint;`09`7B Movement speed`09`7D X X`09`09`09`7B Note: FY and FX constrain dungeon size to 255`09`7D X`09`09fy`09: byteint;`09`7B Y Pointer into map`09`7D X`09`09fx`09: byteint;`09`7B X Pointer into map`09`7D X X`09`09stuned`09: `5Bbit(6),pos(104)`5D -32..31; `7B Rounds stunned`7D X`09`09ml`09: `5Bbit(1),pos(110)`5D boolean; `7B On if shown `7D X`09`09confused: `5Bbit(1),pos(111)`5D boolean; `7B On if confused`7D X`09end; X`09treasure_type = record X`09`09name`09: ttype;`09`7B Object name`09`09`7D +-+-+-+-+-+-+-+- END OF PART 56 +-+-+-+-+-+-+-+-