-+-+-+-+-+-+-+-+ START OF PART 53 -+-+-+-+-+-+-+-+ X i1 : integer; X `5Bexternal(LIB$DAY)`5D function getday( X var daynum : integer; X dum1 : integer := %immed 0; X dum2 : integer := %immed 0) : integer; X external; X begin X getday(i1); X day_num := ((i1+3) mod 7) + 1; X end; X`20 X`20 X`7B Returns the hour number; 0=midnight...23=11 PM `7D X`5Bpsect(setup$code)`5D function hour_num : integer; X var X hour : integer; X time_str : packed array `5B1..11`5D of char; X begin X time(time_str); X readv(substr(time_str,1,2),hour); X hour_num := hour; X end; X`20 X`20 X`7B Check the day-time strings to see if open `7D X`5Bpsect(setup$code)`5D function check_time : boolean; X begin X case days`5Bday_num,(hour_num+5)`5D of X '.' : check_time := false; `7B Closed `7D X 'X' : check_time := true; `7B Normal hours `7D X otherwise check_time := false; `7B Other, assumed closed `7D X end; X end; X`20 X`20 X`7B Generates a random integer x where 1<=X<=MAXVAL `7D X function randint ( %immed maxval : integer ) : integer; X external; X`20 X function rand_rep ( %immed num : integer; %immed die : integer ) : integer V; X external; X`20 X`20 X`7B Generates a random integer number of NORMAL distribution `7D X`5Bpsect(misc1$code)`5D function randnor(mean,stand : integer) : integer; X begin X randnor := trunc(sqrt(-2.0*ln(randint(9999999)/10000000.0))* X cos(6.283*(randint(9999999)/10000000.0))*stand) + mean; X end; X`20 X`20 X`7B Returns position of first set bit `7D X function bit_pos ( %ref test : unsigned ) : integer; X external; X`20 X`20 X`7B Checks a co-ordinate for in bounds status `7D X`5Bpsect(misc1$code)`5D function in_bounds(y,x : integer) : boolean; X begin X if ((y > 1) and (y < cur_height) and X (x > 1) and (x < cur_width)) then X in_bounds := true X else X in_bounds := false; X end; X`20 X`20 X`7B Distance between two points `7D X function distance ( X %immed y1 : integer; X %immed x1 : integer; X %immed y2 : integer; X %immed x2 : integer ) : integer; X external; X`20 X`20 X`7B Checks points north, south, east, and west for a type `7D X`5Bpsect(misc1$code)`5D function next_to4 ( y,x : integer; group_set : obj_s Vet ) : integer; X var X i1 : integer; X begin X i1 := 0; X if (y > 1) then X if (cave`5By-1,x`5D.fval in group_set) then X i1 := i1 + 1; X if (y < cur_height) then X if (cave`5By+1,x`5D.fval in group_set) then X i1 := i1 + 1; X if (x > 1) then X if (cave`5By,x-1`5D.fval in group_set) then X i1 := i1 + 1; X if (x < cur_width) then X if (cave`5By,x+1`5D.fval in group_set) then X i1 := i1 + 1; X next_to4 := i1 X end; X`20 X`20 X`7B Checks all adjacent spots for elements `7D X`5Bpsect(misc1$code)`5D function next_to8 ( X y,x : integer; X group_set : obj_set ) : integer; X var X i1,i2,i3 : integer; X begin X i1 := 0; X for i2 := (y - 1) to (y + 1) do X for i3 := (x - 1) to (x + 1) do X if (in_bounds(i2,i3)) then X if (cave`5Bi2,i3`5D.fval in group_set) then X i1 := i1 + 1; X next_to8 := i1 X end; X`20 X`20 X`7B Link all free space in treasure list together `7D X`5Bpsect(generate$code)`5D procedure tlink; X var X i1 : integer; X begin X for i1 := 1 to max_talloc do X begin X t_list`5Bi1`5D := blank_treasure; X t_list`5Bi1`5D.p1 := i1 - 1; X end; X tcptr := max_talloc; X end; X`20 X`20 X`7B Link all free space in monster list together `7D X`5Bpsect(generate$code)`5D procedure mlink; X var X i1 : integer; X begin X for i1 := 1 to max_malloc do X begin X m_list`5Bi1`5D := blank_monster; X m_list`5Bi1`5D.nptr := i1 - 1; X end; X m_list`5B2`5D.nptr := 0; X muptr := 0; X mfptr := max_malloc; X end; X`20 X`20 X`7B Initializes M_LEVEL array for use with PLACE_MONSTER `7D X`5Bpsect(setup$code)`5D procedure init_m_level; X var X i1,i2,i3 : integer; X begin X i1 := 1; `7Bmain counter, goes by step through c_list`7D X i2 := 0; `7Bcounter for level`7D X i3 := max_creatures - extra_monsters; `7Bmax value for main counter`7 VD X repeat X m_level`5Bi2`5D := 0; X while ((i1 <= i3) and (c_list`5Bi1`5D.level = i2)) do X begin X m_level`5Bi2`5D := m_level`5Bi2`5D + 1; X i1 := i1 + 1; X end; X i2 := i2 + 1; X until (i2 > max_mons_level); X for i1 := 2 to max_mons_level do X m_level`5Bi1`5D := m_level`5Bi1`5D + m_level`5Bi1-1`5D; X end; X`20 X`20 X`7B Initializes T_LEVEL array for use with PLACE_OBJECT `7D X`5Bpsect(setup$code)`5D procedure init_t_level; X var X i1,i2 : integer; X begin X i1 := 1; X i2 := 0; X repeat X while ((i1 <= max_objects) and (object_list`5Bi1`5D.level = i2)) do X begin X t_level`5Bi2`5D := t_level`5Bi2`5D + 1; X i1 := i1 + 1; X end; X i2 := i2 + 1; X until ((i2 > max_obj_level) or (i1 > max_objects)); X for i1 := 1 to max_obj_level do X t_level`5Bi1`5D := t_level`5Bi1`5D + t_level`5Bi1-1`5D; X end; X`20 X `7B Adjust prices of objects `7D X procedure price_adjust; X var X i1 : integer; X begin X for i1 := 1 to max_objects do X with object_list`5Bi1`5D do X cost := trunc(cost*cost_adj + 0.99); X for i1 := 1 to inven_init_max do X with inventory_init`5Bi1`5D do X cost := trunc(cost*cost_adj + 0.99); X end; X`20 X`20 X`7B Converts input string into a dice roll X Normal input string will look like '2d6', '3d8'... ect. `7D X`5Bpsect(misc1$code)`5D function damroll(dice : dtype) : integer; X var X i1,num,sides : integer; X begin X for i1 := 1 to length(dice) do X if (dice`5Bi1`5D = 'd') then X dice`5Bi1`5D := ' '; X num := 0; X sides := 0; X readv(dice,num,sides,error:=continue); X damroll := rand_rep(num,sides); X end; X`20 X`20 X`7B Returns true if no obstructions between two given points `7D X`5Bpsect(misc1$code)`5D function los(y1,x1,y2,x2 : integer) : boolean; X var X ty,tx,stepy,stepx,p1,p2 : integer; X slp,tmp : real; X flag : boolean; X begin X ty := (y1 - y2); X tx := (x1 - x2); X flag := true; X if ((ty <> 0) or (tx <> 0)) then X begin X if (ty < 0) then X stepy := -1 X else X stepy := 1; X if (tx < 0) then X stepx := -1 X else X stepx := 1; X if (ty = 0) then X repeat X x2 := x2 + stepx; X flag := cave`5By2,x2`5D.fopen; X until((x1 = x2) or (not (flag))) X else if (tx = 0) then X repeat X y2 := y2 + stepy; X flag := cave`5By2,x2`5D.fopen; X until((y1 = y2) or (not (flag))) X else if (abs(ty) > abs(tx)) then X begin X slp := abs(tx/ty)*stepx; X tmp := x2; X repeat X y2 := y2 + stepy; X tmp := tmp + slp; X p1 := round(tmp - 0.1); X p2 := round(tmp + 0.1); X if (not ((cave`5By2,p1`5D.fopen) or (cave`5By2,p2`5D.fopen)) V) then X flag := false; X until((y1 = y2) or (not (flag))) X end X else X begin X slp := abs(ty/tx)*stepy; X tmp := y2; X repeat X x2 := x2 + stepx; X tmp := tmp + slp; X p1 := round(tmp - 0.1); X p2 := round(tmp + 0.1); X if (not ((cave`5Bp1,x2`5D.fopen) or (cave`5Bp2,x2`5D.fopen)) V) then X flag := false; X until((x1 = x2) or (not (flag))) X end; X end; X los := flag; X end; X`20 X`20 X`7B Returns symbol for given row, column `7D X`5Bpsect(misc5$code)`5D procedure loc_symbol(y,x : integer; var sym : char); X Begin X with cave`5By,x`5D do X if ((cptr = 1) and (not(find_flag))) then X sym := '@' X else if (py.flags.blind > 0) then X sym := ' ' X else X Begin X if (tptr > 0) then X if (t_list`5Btptr`5D.tval <> 109) then X`09`09sym := t_list`5Btptr`5D.tchar X`09 else if (wall_flag) then X`09 sym := wall_chr`5B(dun_level mod 10) +1`5D X`09 else`20 X`09 sym := '#' X else if (fval < 10) then X sym := '.' X else if (wall_flag) then X`09 sym := wall_chr`5B(dun_level mod 10) +1`5D X`09 else X`09 sym := '#'; X if (cptr > 1) then X begin X with m_list`5Bcptr`5D do X if ((ml) and X ((uand(c_list`5Bmptr`5D.cmove,%X'00010000') = 0) or X (py.flags.see_inv))) then X sym := c_list`5Bmptr`5D.cchar X end; X End; X END; X`20 X`20 X`7B Tests a spot for light or field mark status `7D X`5Bpsect(misc1$code)`5D function test_light(y,x : integer) : boolean; X begin X with cave`5By,x`5D do X if ((pl) or (fm) or (tl)) then X test_light := true X else X test_light := false; X end; X`20 X`20 X`7B Prints the map of the dungeon `7D X`5Bpsect(misc2$code)`5D procedure prt_map; X var X i1,i2,i3,i4,i5,ypos,xpos,isp : integer; X floor_str : vtype; X tmp_char : char; X flag : boolean; X begin X redraw := false; `7B Screen has been redrawn `7D X i3 := 1; `7B Used for erasing dirty lines `7D X i4 := 14; `7B Erasure starts in this column `7D X for i1 := panel_row_min to panel_row_max do `7B Top to bottom `7 VD X begin X i3 := i3 + 1; `7B Increment dirty line ctr `7D X if (used_line`5Bi3`5D) then `7B If line is dirty... `7D X begin X erase_line(i3,i4); `7B erase it. `7D X used_line`5Bi3`5D := false; `7B Now it's a clean line `7D X end; X floor_str := ''; `7B Floor_str is string to be printed`7D X ypos := i1; `7B Save row `7D X flag := false; `7B False until floor_str <> '' `7D X isp := 0; `7B Number of blanks encountered `7D X for i2 := panel_col_min to panel_col_max do `7B Left to right `7 VD X with cave`5Bi1,i2`5D do X begin `7B Get character for location `7D X if (test_light(i1,i2)) then X loc_symbol(i1,i2,tmp_char) X else if ((cptr = 1) and (not(find_flag))) then X tmp_char := '@' X else if (cptr > 1) then X if (m_list`5Bcptr`5D.ml) then X loc_symbol(i1,i2,tmp_char) X else X tmp_char := ' ' X else X tmp_char := ' '; X if (tmp_char = ' ') then`7B If blank... `7D X begin X if (flag) then `7B If floor_str <> '' then `7D X begin X isp := isp + 1; `7B Increment blank ctr `7D X if (isp > 3) then `7B Too many blanks, print`7 VD X begin `7B floor_str and reset `7D X print(floor_str,ypos,xpos); X flag := false; X isp := 0; X end; X end X end X else X begin X if (flag) then `7B Floor_str <> '' `7D X begin X if (isp > 0) then `7B Add on the blanks `7D X begin X for i5 := 1 to isp do X floor_str := floor_str + ' '; X isp := 0; X end; `7B Add on the character `7 VD X floor_str := floor_str + tmp_char; X end X else X begin `7B Floor_str = '' `7D X xpos := i2; `7B Save column for printing `7D X flag := true; `7B Set flag to true `7D X floor_str := tmp_char; `7B Floor_str <> '' `7D X end; X end; X end; X if (flag) then `7B Print remainder, if any `7D X print(floor_str,ypos,xpos); X end; X end; X`20 X`20 X`7B Compact monsters `7D X`5Bpsect(misc2$code)`5D procedure compact_monsters; X var X i1,i2,i3,ctr,cur_dis : integer; X delete_1,delete_any : boolean; X begin X cur_dis := 66; X delete_any := false; X repeat X i1 := muptr; X i2 := 0; X repeat X delete_1 := false; X i3 := m_list`5Bi1`5D.nptr; X with m_list`5Bi1`5D do X if (cur_dis > cdis) then X if (randint(3) = 1) then X begin X if (i2 = 0) then X muptr := i3 X else X m_list`5Bi2`5D.nptr := i3; X cave`5Bfy,fx`5D.cptr := 0; X m_list`5Bi1`5D := blank_monster; X m_list`5Bi1`5D.nptr := mfptr; X mfptr := i1; X ctr := ctr + 1; X delete_1 := true; X delete_any := true; X end; X if (not(delete_1)) then i2 := i1; X i1 := i3; +-+-+-+-+-+-+-+- END OF PART 53 +-+-+-+-+-+-+-+-