-+-+-+-+-+-+-+-+ START OF PART 37 -+-+-+-+-+-+-+-+ X`09`09 20 : i1 := 23; X`09`09 21 : i1 := 23; X`09`09 22 : i1 := 23; X`09`09 23 : i1 := 23; X`09`09 25 : i1 := 23; X`09`09 30 : i1 := 31; X`09`09 31 : i1 := 28; X`09`09 32 : i1 := 32; X`09`09 33 : i1 := 24; X`09`09 34 : i1 := 27; X`09`09 35 : i1 := 26; X`09`09 36 : i1 := 26; X`09`09 40 : i1 := 25; X`09`09 45 : if (inventory`5B29`5D.tval = 0) then `7B Rings `7D X`09`09`09 i1 := 29 X`09`09`09 else X`09`09`09 i1 := 30; X`09`09 otherwise X`09`09`09 begin X`09`09`09 msg_print('I don''t see how you can use that.'); X`09`09`09 test_flag := false; X`09`09`09 com_val := 0; X`09`09`09 end; X`09`09end; X`09`09if (test_flag) then X`09`09 if (inventory`5Bi1`5D.tval > 0) then X`09`09 begin X`09`09 if (uand(%X'80000000',inventory`5Bi1`5D.flags) <> 0) then X`09`09`09begin X`09`09`09 objdes(out_val,i1,false); X`09`09`09 out_val := 'The ' + out_val + ' you are '; X`09`09`09 case i1 of X`09`09`09 23 : out_val := out_val + 'wielding '; X`09`09`09 otherwise out_val := out_val + 'wearing '; X`09`09`09 end; X`09`09`09 msg_print(out_val + 'appears to be cursed.'); X`09`09`09 test_flag := false; X`09`09`09 com_val := 0; X`09`09`09end X`09`09 else if (inven_ctr > 21) then X`09`09`09if (inventory`5Bcom_val`5D.number > 1) then X`09`09`09 if (inventory`5Bcom_val`5D.subval < 512) then X`09`09`09 begin X`09`09`09msg_print('You will have to drop something first.'); X`09`09`09 test_flag := false; X`09`09`09 com_val := 0; X`09`09`09 end; X`09`09 end; X`09`09if (test_flag) then X`09`09 begin X`09`09 unwear_obj := inventory`5Bi1`5D; X`09`09 inventory`5Bi1`5D := inventory`5Bcom_val`5D; X`09`09 with inventory`5Bi1`5D do X`09`09 begin X`09`09`09`09`7B Fix for torches `7D X`09`09`09if ((subval > 255) and (subval < 512)) then X`09`09`09 begin X`09`09`09 number := 1; X`09`09`09 subval := subval - 255; X`09`09`09 end; X`09`09`09`09`7B Fix for weight `7D X`09`09`09inven_weight := inven_weight + weight*number; X`09`09 end; X`09`09 inven_destroy(com_val); `7B Subtracts weight `7D X`09`09 equip_ctr := equip_ctr + 1; X`09`09 py_bonuses(inventory`5Bi1`5D,1); X`09`09 if (unwear_obj.tval > 0) then X`09`09 begin X`09`09`09inventory`5Binven_max`5D := unwear_obj; X`09`09`09tmp := remove(inven_max); X`09`09`09if (tmp < com_val) then X`09`09`09 com_val := tmp; X`09`09 end; X`09`09 case i1 of X`09`09 23 : prt1 := 'You are wielding '; X`09`09 33 : prt1 := 'Your light source is '; X`09`09 otherwise prt1 := 'You are wearing '; X`09`09 end; X`09`09 objdes(prt2,i1,true); X`09`09 i2 := 0; X`09`09 i3 := 22; X`09`09 repeat `7B Get the right letter of equipment `7D X`09`09 i3 := i3 + 1; X`09`09 if (inventory`5Bi3`5D.tval > 0) then X`09`09`09i2 := i2 + 1; X`09`09 until (i3 = i1); X`09`09 out_val := prt1 + prt2 + ' (' + chr(i2+96)+cur_char2(i1); X`09`09 msg_print(out_val); X`09`09 end; X`09 end; X`09 if (scr_state = 0) then X`09 exit_flag := true X`09 else if (inven_ctr = 0) then X`09 exit_flag := true X`09 else if (not(exit_flag)) then X`09 show_inven(com_val,inven_ctr); X`09 until(exit_flag); X`09 if (scr_state <> 0) then prt('You are currently carrying -',1,1); X`09end; X X`09`7B Switch primary and secondary weapons`09`09-RAK-`09`7D X procedure switch_weapon; X`09var X`09 prt1,prt2 : vtype; X`09 tmp_obj : treasure_type; X`09begin X`09 if (uand(%X'80000000',inventory`5B23`5D.flags) <> 0) then X`09 begin X`09 objdes(prt1,23,false); X`09 msg_print('The ' + prt1 + X`09`09`09' you are wielding appears to be cursed.'); X`09 end X`09 else X`09 begin X`09`09`7B Switch weapons `7D X`09 reset_flag := false; X`09 tmp_obj := inventory`5B34`5D; X`09 inventory`5B34`5D := inventory`5B23`5D; X`09 inventory`5B23`5D := tmp_obj; X`09 py_bonuses(inventory`5B34`5D,-1); `7B Subtract bonuses `7D X`09 py_bonuses(inventory`5B23`5D,1); `7B Add bonuses `7D X`09 if (inventory`5B23`5D.tval > 0) then X`09`09begin X`09`09 prt1 := 'Primary weapon : '; X`09`09 objdes(prt2,23,true); X`09`09 msg_print(prt1 + prt2); X`09`09end; X`09 if (inventory`5B34`5D.tval > 0) then X`09`09begin X`09`09 prt1 := 'Secondary weapon : '; X`09`09 objdes(prt2,34,true); X`09`09 msg_print(prt1 + prt2); X`09`09end; X`09 end; X`09 if (scr_state <> 0) then X`09 begin X`09 msg_print(''); X`09 clear(1,1); X`09 prt('You are currently using -',1,1); X`09 show_equip(1); X`09 end; X`09end; X X`09`7B Main logic for INVEN_COMMAND`09`09`09-RAK-`09`7D X begin X`09inven_command := false; X`09exit_flag := false; X`09scr_state := 0; X`09repeat X`09 case command of X`09 'i' : begin `7B Inventory `7D X`09`09 if (inven_ctr = 0) then X`09`09 msg_print('You are not carrying anything.') X`09`09 else if (scr_state <> 1) then X`09`09 begin `7B Sets scr_state to 1 `7D X`09`09`09clear(1,1); X`09`09`09prt('You are currently carrying -',1,1); X`09`09`09show_inven(1,inven_ctr); X`09`09 end; X`09`09 end; X`09 'e' : begin `7B Equipment `7D X`09`09 if (equip_ctr = 0) then X`09`09 msg_print('You are not using any equipment.') X`09`09 else if (scr_state <> 2) then X`09`09 begin `7B Sets scr_state to 2 `7D X`09`09`09clear(1,1); X`09`09`09prt('You are currently using -',1,1); X`09`09`09show_equip(1); X`09`09 end; X`09`09 end; X`09 't' : begin `7B Take off `7D X`09`09 if (equip_ctr = 0) then X`09`09 msg_print('You are not using any equipment.') X`09`09 else if (inven_ctr > 21) then X`09`09 msg_print('You will have to drop something first.') X`09`09 else X`09`09 unwear; `7B May set scr_state to 2 `7D X`09`09 end; X`09 'w' : begin `7B Wear/wield `7D X`09`09 if (inven_ctr = 0) then X`09`09 msg_print('You are not carrying anything.') X`09`09 else X`09`09 wear; `7B May set scr_state to 1 `7D X`09`09 end; X`09 'x' : begin X`09`09 if (inventory`5B23`5D.tval <> 0) then X`09`09 switch_weapon X`09`09 else if (inventory`5B34`5D.tval <> 0) then X`09`09 switch_weapon X`09`09 else X`09`09 msg_print('But you are wielding no weapons.'); X`09`09 end; X`09`7B Special function for other routines `7D X`09 '?' : begin `7B Displays part inven, returns `7D X`09`09 show_inven(r1,r2); X`09`09 scr_state := 0; `7B Clear screen state `7D X`09`09 end; X`09`7B Nonsense command `7D X`09 otherwise ; X`09 end; X`09 if (scr_state > 0) then X`09 begin X`09 prt('quip, inven, ake-off, ear/wield, echange, or `5 VEZ to exit.',24,2); X`09 test_flag := false; X`09 repeat X`09`09inkey(command); X`09`09com_val := ord(command); X`09`09case com_val of X`09`09 0,3,25,26,27,32 : begin `7B Exit from module `7D X`09`09`09`09 exit_flag := true; X`09`09`09`09 test_flag := true; X`09`09`09`09 end; X`09`09 otherwise case command of `7B Module commands `7D X`09`09`09 'e' : test_flag := true; X`09`09`09 'i' : test_flag := true; X`09`09`09 't' : test_flag := true; X`09`09`09 'w' : test_flag := true; X`09`09`09 'x' : test_flag := true; X`09`09`09 '?' : ; `7B Trap special feature `7D X`09`09`09 otherwise ; `7B Nonsense command `7D X`09`09`09 end; X`09`09end; X`09 until (test_flag); X`09 prt('',24,1); X`09 end X`09 else X`09 exit_flag := true; X`09until(exit_flag); X`09if (scr_state > 0) then `7B If true, must redraw screen `7D X`09 inven_command := true; X end; X X X`09`7B Get the ID of an item and return the CTR value of it`09-RAK-`09`7D X function get_item( var com_val : integer; X`09`09`09pmt : vtype; X`09`09`09var redraw : boolean; X`09`09`09i1,i2 : integer) : boolean; X var X`09 command : char; X`09 out_val : vtype; X`09 test_flag : boolean; X begin X`09get_item := false; X`09com_val := 0; X`09if (inven_ctr > 0) then X`09 begin X`09 writev(out_val,'(Items ',chr(i1+96),'-',chr(i2+96), X`09`09 ', * for inventory list, `5EZ to exit) ',pmt); X`09 test_flag := false; X`09 prt(out_val,1,1); X`09 repeat X`09 inkey(command); X`09 com_val := ord(command); X`09 case com_val of X`09`090,3,25,26,27 : begin X`09`09`09`09 test_flag := true; X`09`09`09`09 reset_flag := true; X`09`09`09`09end; X`09`0942 : begin X`09`09`09`09 clear(2,1); X`09`09`09`09 inven_command('?',i1,i2); X`09`09`09`09 redraw := true; X`09`09`09`09end; X`09`09otherwise begin X`09`09`09`09 com_val := com_val - 96; X`09`09`09`09 if ((com_val >= i1) and X`09`09`09`09 (com_val <= i2)) then X`09`09`09`09 begin X`09`09`09`09 test_flag := true; X`09`09`09`09 get_item := true; X`09`09`09`09 end; X`09`09`09`09end; X`09 end; X`09 until (test_flag); X`09 erase_line(msg_line,msg_line); X`09 end X`09else X`09 msg_print('You are not carrying anything.'); X end; X X`09`7B I may have written the town level code, but I'm not exactly `7D X`09`7B proud of it. Adding the stores required some real slucky `7D X`09`7B hooks which I have not had time to re-think. -RAK- `7D X`09%INCLUDE 'MOR_INCLUDE:STORE2.INC' X X X`09`7B Calculates current boundries`09`09`09`09-RAK-`09`7D X procedure panel_bounds; X begin X`09panel_row_min := (trunc(panel_row*(screen_height/2)) + 1); X`09panel_row_max := panel_row_min + screen_height - 1; X`09panel_row_prt := panel_row_min - 2; X`09panel_col_min := (trunc(panel_col*(screen_width/2)) + 1); X`09panel_col_max := panel_col_min + screen_width - 1; X`09panel_col_prt := panel_col_min - 15; X end; X X X`09`7B Given an row (y) and col (x), this routine detects -RAK-`09`7D X`09`7B when a move off the screen has occurred and figures new borders`7D X function get_panel(y,x : integer) : boolean; X var X`09`09prow,pcol : integer; X begin X`09prow := panel_row; X`09pcol := panel_col; X`09if ((y < panel_row_min + 2) or (y > panel_row_max - 2)) then X`09 begin X`09 prow := trunc((y - 2)/(screen_height/2)); X`09 if (prow > max_panel_rows) then X`09 prow := max_panel_rows; X`09 end; X`09if ((x < panel_col_min + 3) or (x > panel_col_max - 3)) then X`09 begin X`09 pcol := trunc((x - 3)/(screen_width/2)); X`09 if (pcol > max_panel_cols) then X`09 pcol := max_panel_cols; X`09 end; X`09if ((prow <> panel_row) or (pcol <> panel_col) or not(cave_flag)) then X`09 begin X`09 panel_row := prow; X`09 panel_col := pcol; X`09 panel_bounds; X`09 get_panel := true; X`09 cave_flag := true; X`09 end X`09else X`09 get_panel := false; X end; X X X`09`7B Tests a given point to see if it is within the screen -RAK-`09`7D X`09`7B boundries. `7D X function panel_contains(y,x : integer) : boolean; X begin X`09if ((y >= panel_row_min) and (y <= panel_row_max)) then X`09 if ((x >= panel_col_min) and (x <= panel_col_max)) then X`09 panel_contains := true X`09 else X`09 panel_contains := false X`09else X`09 panel_contains := false; X end; X X X`09`7B Returns true if player has no light`09`09`09-RAK-`09`7D X function no_light : boolean; X begin X`09no_light := false; X`09with cave`5Bchar_row,char_col`5D do X`09 if (not(tl)) then X`09 if (not(pl)) then X`09 no_light := true; X end; X X X`09`7B Prompts for a direction`09`09`09`09-RAK-`09`7D X function get_dir(prompt : vtype; X`09`09 var dir,com_val,y,x : integer) : boolean; X var X`09`09temp_prompt : vtype; X`09`09flag : boolean; X`09`09command : char; X begin X`09flag := false; X`09temp_prompt := '(1 2 3 4 6 7 8 9) ' + prompt; X`09prompt := ''; X`09repeat X`09 if (get_com(prompt,command)) then X`09 begin X`09 com_val := ord(command); X`09 dir := com_val - 48; X`09`09`7B Note that '5' is not a valid direction `7D X`09 if (dir in `5B1,2,3,4,6,7,8,9`5D) then X`09`09begin X`09`09 move(dir,y,x); X`09`09 flag := true; X`09`09 get_dir := true; X`09`09end X`09 else X`09`09prompt := temp_prompt; X`09 end X`09 else X`09 begin X`09 reset_flag := true; X`09 get_dir := false; X`09 flag := true; X`09 end; X`09until (flag); X end; X X X X`09`7B Moves creature record from one space to another`09-RAK-`09`7D X procedure move_rec(y1,x1,y2,x2 : integer); X begin X`09if ((y1 <> y2) or (x1 <> x2)) then X`09 begin X`09 cave`5By2,x2`5D.cptr := cave`5By1,x1`5D.cptr; X`09 cave`5By1,x1`5D.cptr := 0 X`09 end X end; X X X`09`7B Room is lit, make it appear`09`09`09`09-RAK-`09`7D X procedure light_room(y,x : integer); X var X`09tmp1,tmp2 : integer; X`09start_row,start_col : integer; X`09end_row,end_col : integer; X`09i1,i2 : integer; X`09ypos,xpos : integer; X`09floor_str : vtype; X`09tmp_char : char; X X X procedure find_light(y1,x1,y2,x2 : integer); X var X`09i1,i2,i3,i4 : integer; X begin X`09for i1 := y1 to y2 do X`09 for i2 := x1 to x2 do X`09 if (cave`5Bi1,i2`5D.fval in `5B1,2`5D) then X`09 begin X`09`09for i3 := i1-1 to i1+1 do X`09`09 for i4 := i2-1 to i2+1 do X`09`09 cave`5Bi3,i4`5D.pl := true; X`09`09cave`5Bi1,i2`5D.fval := 2; X`09 end; X end; X X begin X tmp1 := trunc(screen_height/2); X tmp2 := trunc(screen_width /2); X start_row := trunc(y/tmp1)*tmp1 + 1; X start_col := trunc(x/tmp2)*tmp2 + 1; X end_row := start_row + tmp1 - 1; X end_col := start_col + tmp2 - 1; X find_light(start_row,start_col,end_row,end_col); X for i1 := start_row to end_row do X`09begin X`09 floor_str := ''; X`09 ypos := i1; +-+-+-+-+-+-+-+- END OF PART 37 +-+-+-+-+-+-+-+-