-+-+-+-+-+-+-+-+ START OF PART 29 -+-+-+-+-+-+-+-+ X Many of which have been extremely modified by -RLG`7D X X X`7B Returns a '*' for cursed items, a ')' for normal ones X NOTE: '*' returned only if item has been identified.`7D X function cur_char1(item_val : integer) : dtype; X BEGIN X with inventory`5Bitem_val`5D do X if (uand(%X'80000000',flags) = 0) then X cur_char1 := ')' `7B Not cursed.`7D X else if (index(name,'`7C') > 0) then X cur_char1 := ')' `7B Cursed, but not identified `7D X else if (index(name,'`5E') > 0) then X cur_char1 := ')' `7B Cursed, but not identified `7D X else X cur_char1 := '*' `7B Cursed and identified.`7D X END; X`20 X`20 X`7B Returns a '*' for cursed items, a ')' for normal ones `7D X function cur_char2(item_val : integer) : char; X BEGIN X with equipment`5Bitem_val`5D do X if (uand(%X'80000000',flags) = 0) then X cur_char2 := ')' `7B Not cursed.`7D X else X cur_char2 := '*'; `7B Cursed.`7D X END; X X `7BReturns the character label (a-Z) of an integer.`7D X function raoul_label(position : integer) : dtype; X BEGIN X raoul_label := substr(alpha_set,position,1); X END; X`20 X`20 X`7B Comprehensive function block to handle all inventory X and equipment routines. Five kinds of calls can take place. X Note that '?' is a special call for other routines to display X only a portion of the inventory, and take no other action. `7D X X function inven_command(command : char; r1,r2 : integer) : boolean; X var X com_val,scr_state : integer; X`09cur_top`09`09 : integer; X exit_flag,test_flag : boolean; X`20 X `7B Displays inventory items from r1 to r2 `7D X `7Br1 can be cur_top or start of range, r2 can be inven_ctr or end of rang Ve`7D X X procedure show_inven(r1,r2 : integer); `7BMuch Improved by RLG`7D X var X i1 `09`09 : integer; X tmp_val,out_val : vtype; X X BEGIN X if (r1 > 0) then `7B R1 = 0 dummy call `7D X BEGIN X`09 clear(2,1); X scr_state := 1; `7B Set state to 1 `7D X`09 if (r2-r1 > inven_per_page-1) then X`09 r2 := r1 + inven_per_page-1; X for i1 := 0 to (r2-r1) do X`09`09 begin X`09`09 objdes(tmp_val,r1+i1,true,'i'); X writev(out_val,raoul_label(r1+i1), X`09`09 `09`09 cur_char1(r1+i1),' ',tmp_val); X prt(out_val,i1+2,1); X`09`09 end; X END; X END; X X`7B Displays equipment items from r1 to end `7D X procedure show_equip(r1 : integer); X var X i1,i2 : integer; X prt1,prt2,out_val : vtype; X BEGIN X if (r1 > equip_ctr) then `7B Last item gone `7D X prt('',equip_ctr+3,1) X else if (r1 > 0) then `7B R1 = 0 dummy call `7D X BEGIN X i2 := 0; X for i1 := 23 to equip_max do`7B Range of equipment `7D X BEGIN X with equipment`5Bi1`5D do X if (tval > 0) then X BEGIN X i2 := i2 + 1; X if (i2 >= r1) then`7B Display only given range `7D X BEGIN X CASE i1 of `7B Get position `7D X 23 : prt1 := ' You are wielding : '; X 24 : prt1 := ' Worn on head : '; X 25 : prt1 := ' Worn around neck : '; X 26 : prt1 := ' Worn on body : '; X 27 : prt1 := ' Worn on arm : '; X 28 : prt1 := ' Worn on hands : '; X 29 : prt1 := ' Worn on right hand : '; X 30 : prt1 := ' Worn on left hand : '; X 31 : prt1 := ' Worn on feet : '; X 32 : prt1 := ' Worn about body : '; X 33 : prt1 := ' Light source : '; X 34 : prt1 := ' Secondary weapon : '; X 35 : prt1 := ' Computer : '; X otherwise prt1 := ' Unknown value: '; X END; X objdes(prt2,i1,true,'e'); X writev(out_val,chr(i2+96),cur_char2(i1), X prt1,prt2); X prt(out_val,i2+2,1); X END; X END; X END; X prt('',i2+3,1); `7B Clear last line `7D X scr_state := 2; `7B Set state of screen `7D X END; X END; X X`7BSummary of player's inventory displayed to the screen`7D`20 X procedure count_inventory; X var X i1,i2,i3,row,num`09: integer; X BEGIN X num := 0; X prt('Inventory Summary',16,22); X row := 17; X if (find_range(`5B20..23`5D,i2,i3)) then X begin X num := i3-i2+1; X`09 row := row+1; X`09 prt_num('Weapons : ',num,row,7); X end; X if (find_range(`5B30..36`5D,i2,i3)) then X begin X num := i3-i2+1; X`09 row := row+1; X`09 prt_num('Armor : ',num,row,7); X end; X if (find_range(`5B82,84`5D,i2,i3)) then X begin X num := 0; X for i1 := i2 to i3 do X`09 num := num + inventory`5Bi1`5D.number; X`09 row := row+1; X`09 prt_num('Thrown/Grenades : ',num,row,7); X end; X if (find_range(`5B10,11,12`5D,i2,i3)) then X begin X num := 0; X for i1 := i2 to i3 do X`09 num := num + inventory`5Bi1`5D.number; X`09 row := row+1; X`09 prt_num('Rounds of Ammo : ',num,row,7); X end; X if (find_range(`5B80`5D,i2,i3)) then X begin X num := 0; X for i1 := i2 to i3 do X`09 num := num + inventory`5Bi1`5D.number; X`09 row := row+1; X`09 prt_num('Food Items : ',num,row,7); X end; X row := 17; X if (find_range(`5B75,76`5D,i2,i3)) then X begin X num := 0; X for i1 := i2 to i3 do X`09 num := num + inventory`5Bi1`5D.number; X`09 row := row+1; X`09 prt_num('Potions : ',num,row,35); X end; X if (find_range(`5B70,71`5D,i2,i3)) then X begin X num := 0; X for i1 := i2 to i3 do X`09 num := num + inventory`5Bi1`5D.number; X`09 row := row+1; X`09 prt_num('Floppy Disks : ',num,row,35); X end; X if (find_range(`5B65`5D,i2,i3)) then X begin X num := i3-i2+1; X`09 row := row+1; X`09 prt_num('Ray Guns : ',num,row,35); X end; X if (find_range(`5B55`5D,i2,i3)) then X begin X num := i3-i2+1; X`09 row := row+1; X`09 prt_num('Wierd Devices : ',num,row,35); X end; X if (find_range(`5B40,45`5D,i2,i3)) then X begin X num := i3-i2+1; X`09 row := row+1; X`09 prt_num('Amulets/Rings : ',num,row,35); X end; X END; X X`7B Displays inventory items and cleans item from list `7D X procedure clean; X var X com_val`09 : integer; X out_val`09 : vtype; X`09`09command`09 : char; X`09`09exit_flag,test_flag : boolean; X BEGIN X exit_flag := false; X`09 repeat X`09 test_flag := false; X`09 repeat X writev(out_val, X`09 '( for next page, to exit ) ', X`09 'Lose which item ?'); X prt(out_val,1,1); X`09 inkey(command); X`09 com_val := ord(command); X`09 case com_val of X 0,3,13,25,26,27 : begin X`09`09`09 test_flag := true; X`09`09`09 exit_flag := true; X`09`09`09 end;`09`09 `20 X`09`09 32 : begin X`09`09`09 if (cur_top+inven_per_page <= inven_ctr) then X `09`09`09`09 cur_top := cur_top + inven_per_page X`09`09`09 else X`09`09`09 cur_top := 1; X show_inven(cur_top,inven_ctr); X end; X X otherwise begin X`09`09`09 com_val := index(alpha_set,command); X`09`09`09 if (com_val in `5B1..inven_ctr`5D) then X begin X`09`09`09 objdes(out_val,com_val,true,'i'); X`09`09`09 out_val := 'Destroyed ' + out_val; X`09`09`09 inven_destroy(com_val); X`09`09`09 show_inven(cur_top,inven_ctr); X`09`09`09 msg_print(out_val); X`09`09`09 msg_print(''); X test_flag := true; X end; X`09`09`09 end; X`09 end; X`09 until (test_flag); X until (exit_flag); X erase_line(msg_line,msg_line); X END; X`20 X`7B Remove item from equipment list `7D X function remove(item_val : integer) : integer; X var X i1,i2,typ `09 : integer; X out_val,prt1,prt2 : vtype; X flag`09`09 : boolean; X`09 item_removed`09 : treasure_type; X X BEGIN X i1 := 0; X flag := false; X`09 if (item_val = -1) then X`09 item_removed := temporary_slot X`09 else X item_removed := equipment`5Bitem_val`5D; X`09 typ := item_removed.tval; X repeat X i1 := i1 + 1; X with inventory`5Bi1`5D do X if (typ > tval) then X BEGIN X for i2 := inven_ctr downto i1 do X inventory`5Bi2+1`5D := inventory`5Bi2`5D; X inventory`5Bi1`5D := item_removed; X inven_ctr:= inven_ctr + 1; X equip_ctr:= equip_ctr - 1; X flag := true; X END; X until (flag); X CASE typ of X 10,11,12,20,21,22,23,25 : prt1 := 'Was wielding '; X 15 : prt1 := 'Light source was '; X otherwise prt1 := 'Was wearing '; X END; X objdes(prt2,i1,true,'i'); X`09 writev(out_val,prt1,prt2,' (',raoul_label(i1),')'); X msg_print(out_val); X`09 if (item_val = -1) then X`09 temporary_slot := blank_treasure X`09 else`20 X`09 equipment`5Bitem_val`5D := blank_treasure;`09 `20 X if (item_val <> equip_max) then `7B For secondary weapon`7D X py_bonuses(inventory`5Bi1`5D,-1); X remove := i1; X END; X`20 X`7B Unwear routine, remove a piece of equipment `7D X procedure unwear; X var X i1,i2,com_val : integer; X exit_flag,test_flag : boolean; X command : char; X out_val : vtype; X BEGIN X if (scr_state = 1) then X BEGIN X clear(1,1); X show_equip(1); X END; X exit_flag := false; X repeat X writev(out_val,'(a-',chr(equip_ctr+96), X`09 `09`09 ', for equipment list,', X`09`09`09 ' to exit) ','Take off which one ?'); X test_flag := false; X msg_print(out_val); X repeat X inkey(command); X com_val := ord(command); X CASE com_val of X 0,3,25,26,27 : BEGIN X test_flag := true; X exit_flag := true; X END; X 32 : BEGIN X clear(2,1); X show_equip(1); X END; X otherwise BEGIN X com_val := com_val - 96; X if ((com_val >= 1) and X (com_val <= equip_ctr)) then X test_flag := true; X END; X END; X until (test_flag); X if (not(exit_flag)) then X BEGIN X reset_flag := false; `7B Player turn `7D X i1 := 0; X i2 := 22; X repeat X i2 := i2 + 1; X if (equipment`5Bi2`5D.tval > 0) then X i1 := i1 + 1; X until (i1 = com_val); X if (uand(%X'80000000',equipment`5Bi2`5D.flags) <> 0) then X BEGIN X msg_print('Hmmm, it seems to be really stuck...'); X com_val := 0; X END X else X remove(i2); X END; X if (scr_state = 0) then X exit_flag := true X else if (equip_ctr = 0) then X exit_flag := true X else if (inven_ctr > 21) then X exit_flag := true X else if (not(exit_flag)) then X show_equip(com_val); X until(exit_flag); X if (scr_state <> 0) then X if (equip_ctr = 0) then X clear(1,1) X else X prt('You are currently using -',1,1); X END; X`20 X`7B Wear routine, wear or wield an item `7D X procedure wear; X var X com_val,i1,i2,i3,tmp : integer; X out_val,prt1,prt2 : vtype; X unwear_obj`09 : treasure_type; X exit_flag,test_flag : boolean; X`09 `20 X BEGIN X exit_flag := false; X`09 repeat X `09 test_flag := false; X repeat X writev(out_val, X`09 '( for next page, to exit ) ', X`09 'Wear/Wield which item?'); X prt(out_val,1,1); X`09 inkey(command); X`09 com_val := ord(command); X`09 case com_val of X 0,3,13,25,26,27 : begin `7B Exit from module `7D X`09`09`09 test_flag := true; X exit_flag := true; X`09`09 end; X X`09`09 32 : if (scr_state <> 1) then `7Bset scr_state to 1`7D X`09`09`09 show_inven(cur_top,inven_ctr) X`09`09`09 else X`09`09`09 begin X`09`09`09 if (cur_top+inven_per_page <= inven_ctr) then X `09`09`09`09 cur_top := cur_top + inven_per_page X`09`09`09 else X`09`09`09 cur_top := 1; +-+-+-+-+-+-+-+- END OF PART 29 +-+-+-+-+-+-+-+-