-+-+-+-+-+-+-+-+ START OF PART 42 -+-+-+-+-+-+-+-+ X if ((y < panel_row_min + 2) or (y > panel_row_max - 2)) then X BEGIN X prow := trunc((y - 2)/(screen_height/2)); X if (prow > max_panel_rows) then X prow := max_panel_rows; X END; X if ((x < panel_col_min + 3) or (x > panel_col_max - 3)) then X BEGIN X pcol := trunc((x - 3)/(screen_width/2)); X if (pcol > max_panel_cols) then X pcol := max_panel_cols; X END; X if ((prow <> panel_row) or (pcol <> panel_col) or not(cave_flag)) th Ven X BEGIN X panel_row := prow; X panel_col := pcol; X panel_bounds; X get_panel := true; X cave_flag := true; X END X else X get_panel := false; X END; X`20 X`20 X`7B Tests a given point to see if it is within the screen X boundries. `7D X function panel_contains(y,x : integer) : boolean; X BEGIN X if ((y >= panel_row_min) and (y <= panel_row_max)) then X if ((x >= panel_col_min) and (x <= panel_col_max)) then X panel_contains := true X else X panel_contains := false X else X panel_contains := false; X END; X`20 X`20 X`7B Returns true if player has no light `7D X function no_light : boolean; X BEGIN X no_light := false; X with cave`5Bchar_row,char_col`5D do X if (not(tl)) then X if (not(pl)) then X no_light := true; X END; X`20 X`20 X`7B Prompts for a direction `7D X function get_dir(prompt : vtype; X var dir,com_val,y,x : integer) : boolean; X var X temp_prompt : vtype; X flag: boolean; X command: char; X BEGIN X flag := false; X temp_prompt := '(1 2 3 4 6 7 8 9) ' + prompt; X prompt := ''; X repeat X if (get_com(prompt,command)) then X BEGIN X com_val := ord(command); X dir := com_val - 48; X`7B Note that '5' is not a valid direction `7D X if (dir in `5B1,2,3,4,6,7,8,9`5D) then X BEGIN X move(dir,y,x); X flag := true; X get_dir := true; X END X else X prompt := temp_prompt; X END X else X BEGIN X reset_flag := true; X get_dir := false; X flag := true; X END; X until (flag); X END; X`20 X`20 X`20 X`7B Moves creature record from one space to another `7D X procedure move_rec(y1,x1,y2,x2 : integer); X BEGIN X if ((y1 <> y2) or (x1 <> x2)) then X BEGIN X cave`5By2,x2`5D.cptr := cave`5By1,x1`5D.cptr; X cave`5By1,x1`5D.cptr := 0 X END X END; X`20 X`20 X`7B Room is lit, make it appear `7D X procedure light_room(y,x : integer); X var X tmp1,tmp2: integer; X start_row,start_col : integer; X end_row,end_col: integer; X i1,i2 : integer; X ypos,xpos: integer; X floor_str: vtype; X tmp_char : char; X`20 X`20 X procedure find_light(y1,x1,y2,x2 : integer); X var X i1,i2,i3,i4 : integer; X BEGIN X for i1 := y1 to y2 do X for i2 := x1 to x2 do X if (cave`5Bi1,i2`5D.fval in `5B1,2`5D) then X BEGIN X for i3 := i1-1 to i1+1 do X for i4 := i2-1 to i2+1 do X cave`5Bi3,i4`5D.pl := true; X cave`5Bi1,i2`5D.fval := 2; X END; X END; X`20 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 BEGIN X floor_str := ''; X ypos := i1; X for i2 := start_col to end_col do X with cave`5Bi1,i2`5D do X BEGIN X if ((pl) or (fm)) then X BEGIN X if (length(floor_str) = 0) then X xpos := i2; X loc_symbol(i1,i2,tmp_char); X floor_str := floor_str + tmp_char X END X else X if (length(floor_str) > 0) then X BEGIN X print(floor_str,ypos,xpos); X floor_str := '' X END X END; X if (length(floor_str) > 0) then X print(floor_str,ypos,xpos) X END; X END; X`20 X`20 X`7B Lights up given location `7D X procedure lite_spot(y,x : integer); X var X spot_char : vtype; X temp: char; X BEGIN X if (panel_contains(y,x)) then X BEGIN X loc_symbol(y,x,temp); X spot_char := temp; X print(spot_char,y,x) X END X END; X`20 X`20 X`7B Blanks out given location `7D X procedure unlite_spot(y,x : integer); X BEGIN X if (panel_contains(y,x)) then X print(' ',y,x); X END; X`20 X`20 X`7B Package for moving the character's light about the screen X Three cases : Normal, Finding, and Blind `7D X procedure move_light(y1,x1,y2,x2 : integer); X`20 X`7B Maximum of a minimum `7D X function maxmin ( %immed x:integer; X %immed y:integer; X %immed z:integer ) : integer; external; X`20 X`7B Minimum of a maximum `7D X function minmax ( %immed x:integer; X %immed y:integer; X %immed z:integer ) : integer; external; X`20 X`7B Given two sets of points, draw the block `7D X procedure draw_block(y1,x1,y2,x2 : integer); X var X i1,i2,xpos: integer; X topp,bott,left,righ: integer; X new_topp,new_bott,new_left,new_righ : integer; X floor_str,save_str : vtype; X tmp_char : char; X flag: boolean; X BEGIN X`7B From uppermost to bottom most lines player was on. X Points are guaranteed to be on the screen (I hope...) `7D X topp := maxmin(y1,y2,panel_row_min); X bott := minmax(y1,y2,panel_row_max); X left := maxmin(x1,x2,panel_col_min); X righ := minmax(x1,x2,panel_col_max); X new_topp := y2 - 1; `7B Margins for new things to appear`7D X new_bott := y2 + 1; X new_left := x2 - 1; X new_righ := x2 + 1; X for i1 := topp to bott do X BEGIN X floor_str := ''; `7B Null out print string `7D X xpos:= 0; X save_str := ''; X for i2 := left to righ do `7B Leftmost to rightmost do`7D X BEGIN X with cave`5Bi1,i2`5D do X BEGIN X if ((pl) or (fm)) then X if (((i1=y1) and (i2=x1)) or ((i1=y2) and (i2=x2))) th Ven X flag := true X else X flag := false X else X BEGIN X flag := true; X if (((i1 >= new_topp) and (i1 <= new_bott)) and X ((i2 >= new_left) and (i2 <= new_righ))) then X BEGIN X if (tl) then X if (fval in pwall_set) then X pl := true X else if (tptr > 0) then X if (t_list`5Btptr`5D.tval in light_set) then X if (not(fm)) then X fm := true; X END X END; X if ((pl) or (tl) or (fm)) then X loc_symbol(i1,i2,tmp_char) X else X tmp_char := ' '; X if (py.flags.image > 0) then X if (randint(12) = 1) then X tmp_char := chr(randint(95) + 31); X if (flag) then X BEGIN X if (xpos = 0) then xpos := i2; X if (length(save_str) > 0) then X BEGIN X floor_str := floor_str + save_str; X save_str := ''; X END; X floor_str := floor_str + tmp_char; X END X else if (xpos > 0) then X save_str := save_str + tmp_char; X END; X END; X if (xpos > 0) then X BEGIN X i2 := i1; `7B Var for PRINT cannot be loop index`7D X print(floor_str,i2,xpos); X END; X END; X END; X`20 X`20 X`7B Normal movement `7D X procedure sub1_move_light(y1,x1,y2,x2 : integer); X var X i1,i2 : integer; X BEGIN X light_flag := true; X for i1 := y1-1 to y1+1 do `7B Turn off lamp light `7D X for i2 := x1-1 to x1+1 do X cave`5Bi1,i2`5D.tl := false; X for i1 := y2-1 to y2+1 do X for i2 := x2-1 to x2+1 do X cave`5Bi1,i2`5D.tl := true; X draw_block(y1,x1,y2,x2); `7B Redraw area `7D X END; X`20 X`7B When FIND_FLAG, light only permanent features `7D X procedure sub2_move_light(y1,x1,y2,x2 : integer); X var X i1,i2,xpos : integer; X floor_str,save_str : vtype; X tmp_char: char; X flag : boolean; X BEGIN X if (light_flag) then X BEGIN X for i1 := y1-1 to y1+1 do X for i2 := x1-1 to x1+1 do X cave`5Bi1,i2`5D.tl := false; X draw_block(y1,x1,y1,x1); X light_flag := false; X END; X for i1 := y2-1 to y2+1 do X BEGIN X floor_str := ''; X save_str := ''; X xpos := 0; X for i2 := x2-1 to x2+1 do X with cave`5Bi1,i2`5D do X BEGIN X flag := false; X if (not((fm) or (pl))) then X BEGIN X tmp_char := ' '; X if (player_light) then X if (fval in pwall_set) then X BEGIN X pl := true; `7B Turn on perm light `7D X loc_symbol(i1,i2,tmp_char); X flag := true; X END X else X if (tptr > 0) then X if (t_list`5Btptr`5D.tval in light_set) then X BEGIN X fm := true; `7B Turn on field marker`7D X loc_symbol(i1,i2,tmp_char); X flag := true; X END; X END X else X loc_symbol(i1,i2,tmp_char); X if (flag) then X BEGIN X if (xpos = 0) then xpos := i2; X if (length(save_str) > 0) then X BEGIN X floor_str := floor_str + save_str; X save_str := ''; X END; X floor_str := floor_str + tmp_char; X END X else if (xpos > 0) then X save_str := save_str + tmp_char; X END; X if (xpos > 0) then X BEGIN X i2 := i1; X print(floor_str,i2,xpos); X END; X END; X END; X`20 X`7B When blinded, move only the player symbol.`7D X procedure sub3_move_light(y1,yx1,y2,x2 : integer); X var X i1,i2 : integer; X BEGIN X if (light_flag) then X BEGIN X for i1 := y1-1 to y1+1 do X for i2 := x1-1 to x1+1 do X cave`5Bi1,i2`5D.tl := false; X light_flag := false; X END; X print(' ',y1,x1); X print('@',y2,x2); X END; X`20 X`7B With no light, movement becomes involved.`7D X procedure sub4_move_light(y1,x1,y2,x2 : integer); X var X i1,i2 : integer; X BEGIN X light_flag := true; X if (cave`5By1,x1`5D.tl) then X BEGIN X for i1 := y1-1 to y1+1 do X for i2 := x1-1 to x1+1 do X BEGIN X cave`5Bi1,i2`5D.tl := false; X if (test_light(i1,i2)) then X lite_spot(i1,i2) X else X unlite_spot(i1,i2); X END; X END X else if (test_light(y1,x1)) then X lite_spot(y1,x1) X else X unlite_spot(y1,x1); X print('@',y2,x2); X END; X`20 X`7B BEGIN move_light procedure `7D X BEGIN X if (py.flags.blind > 0) then X sub3_move_light(y1,x1,y2,x2) X else if (find_flag) then X sub2_move_light(y1,x1,y2,x2) X else if (not(player_light)) then X sub4_move_light(y1,x1,y2,x2) X else X sub1_move_light(y1,x1,y2,x2); X END; X`20 X`20 X`7B Returns random co-ordinates `7D X procedure new_spot(var y,x : integer); X BEGIN X repeat X y := randint(cur_height); X x := randint(cur_width); X until ( (cave`5By,x`5D.fopen) and X (cave`5By,x`5D.cptr = 0) and X (cave`5By,x`5D.tptr = 0)); X END; X`20 X`20 X`7B Search Mode enhancement `7D X procedure search_on; X BEGIN X search_flag := true; X change_speed(+1); X py.flags.status := uor(py.flags.status,%X'00000100'); X prt_search; X with py.flags do X food_digested := food_digested + 1; X END; X`20 X procedure search_off; X BEGIN X search_flag := false; X find_flag := false; +-+-+-+-+-+-+-+- END OF PART 42 +-+-+-+-+-+-+-+-