-+-+-+-+-+-+-+-+ START OF PART 37 -+-+-+-+-+-+-+-+ X`09 writev(out_val,'(a-',chr(inven_ctr+96),', * for equipment list,', X`09`09' `5EZ to exit) ','Wear/Wield which one ?'); X`09 test_flag := false; X`09 msg_print(out_val); 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 :`09begin X`09`09`09`09 test_flag := true; X`09`09`09`09 exit_flag := true; X`09`09`09`09end; X`09`0942`09 :`09begin X`09`09`09`09 clear(2,1); X`09`09`09`09 show_inven(1,inven_ctr); X`09`09`09`09end; X`09`09otherwise`09begin X`09`09`09`09 com_val := com_val - 96; X`09`09`09`09 if ((com_val >= 1) and`20 X`09`09`09`09 (com_val <= inven_ctr)) then`20 X`09`09`09`09 test_flag := true; X`09`09`09`09end; X`09 end; X`09 until (test_flag); X`09 if (not(exit_flag)) then`09`7B Main logic for wearing`09`7D X`09 begin X`09`09reset_flag := false;`09`7B Player turn`09`7D X`09 test_flag := true; X`09`09case inventory`5Bcom_val`5D.tval of`09`7B Slot for equipment`09`7D X`09`09 10`09: i1 := 23; X`09`09 11`09: i1 := 23; X`09`09 12`09: i1 := 23; X`09`09 15`09: i1 := 33; X`09`09 20`09: i1 := 23; X`09`09 21`09: i1 := 23; X`09`09 22`09: i1 := 23; X`09`09 23`09: i1 := 23; X`09`09 25`09: i1 := 23; X`09`09 30`09: i1 := 31; X`09`09 31`09: i1 := 28; X`09`09 32`09: i1 := 32; X`09`09 33`09: i1 := 24; X`09`09 34`09: i1 := 27; X`09`09 35`09: i1 := 26; X`09`09 36 `09: i1 := 26; X`09`09 40`09: i1 := 25; X`09`09 45`09: if (inventory`5B29`5D.tval = 0) then`09`7B Rings`09`7D X`09`09`09 i1 := 29 X`09`09`09 else X`09`09`09 i1 := 30; X`09`09 otherwise`20 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 begin 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 : `09out_val := out_val + 'wielding '; X`09`09`09 otherwise `09out_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 end 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`09`7D X`09`09 if ((subval > 255) and (subval < 512)) then X`09`09 begin X`09`09 number := 1;`20 X`09`09 subval := subval - 255; X`09`09 end; X`09`09`09`09`7B Fix for weight`09`7D X`09`09`09inven_weight := inven_weight + weight*number; X`09`09 end; X`09`09 inven_destroy(com_val);`09`7B Subtracts weight`09`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`09`7B Get the right letter of equipment`09`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`09`09`09`09: vtype; X`09 tmp_obj`09`09`09`09: 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 +`20 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`09`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);`09`7B Subtract bonuses`09`7D X`09 py_bonuses(inventory`5B23`5D,1);`09`7B Add bonuses`09`09`7D X`09 if (inventory`5B23`5D.tval > 0) then X`09 begin X`09 prt1 := 'Primary weapon : '; X`09 objdes(prt2,23,true); X`09 msg_print(prt1 + prt2); X`09 end; X`09 if (inventory`5B34`5D.tval > 0) then X`09 begin X`09 prt1 := 'Secondary weapon : '; X`09 objdes(prt2,34,true); X`09 msg_print(prt1 + prt2); X`09 end; 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`09`09`7B Inventory`09`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`09`7B Sets scr_state to 1`09`09`7D X`09`09 clear(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`09`09`7B Equipment`09`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`09`7B Sets scr_state to 2`09`09`7D X`09`09 clear(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'`09: begin`09`09`7B Take off`09`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;`09`7B May set scr_state to 2`09`7D X`09`09 end; X`09 'w'`09: begin`09`09`7B Wear/wield`09`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;`09`7B May set scr_state to 1`09`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`09`09`09`7D X`09 '?' : begin`09`7B Displays part inven, returns`09`7D X`09`09 show_inven(r1,r2); X`09`09 scr_state := 0;`09`7B Clear screen state`09`7D X`09`09 end; X`09`7B Nonsense command`09`09`09`09`09`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 inkey(command); X`09 com_val := ord(command); X`09 case com_val of X`09 0,3,25,26,27,32 : begin`09`7B Exit from module`09`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`09`7B Module commands`09`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 '?' : ;`09`09`7B Trap special feature`09`7D X`09`09`09 otherwise ;`09`7B Nonsense command`09`7D X`09`09`09 end; X`09 end; 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`09`09`7B If true, must redraw screen`09`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(`09var com_val`09: integer; X`09`09`09pmt`09 `09: vtype; X`09`09`09var redraw`09: boolean; X`09`09`09i1,i2`09`09: integer) : boolean; X var X`09 command `09`09`09`09`09: char; X`09 out_val`09`09`09`09`09: vtype; X`09 test_flag`09`09`09`09`09: 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 :`09begin X`09`09`09`09 test_flag := true; X`09`09`09`09 reset_flag := true; X`09`09`09`09end; X`09`0942`09 :`09begin 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`09begin X`09`09`09`09 com_val := com_val - 96; X`09`09`09`09 if ((com_val >= i1) and`20 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`09`7D X`09`7B proud of it. Adding the stores required some real slucky`09`7D X`09`7B hooks which I have not had time to re-think.`09`09-RAK-`09`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`09: 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`09-RAK-`09`7D X`09`7B boundries.`09`09`09`09`09`09`09`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`09: vtype; X`09`09flag`09`09: boolean; X`09`09command`09`09: 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`09`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`09`09: integer; X`09start_row,start_col`09: integer; X`09end_row,end_col`09`09: integer; X`09i1,i2`09`09`09: integer; X`09ypos,xpos`09`09: integer; +-+-+-+-+-+-+-+- END OF PART 37 +-+-+-+-+-+-+-+-