-+-+-+-+-+-+-+-+ START OF PART 29 -+-+-+-+-+-+-+-+ X fire_ball(5,dir,char_row,char_col,49,'Fire Ball'); X 30 : destroy_area(char_row,char_col); X 31 : genocide; X otherwise ; X END; X `7B END of spells.`7D X if (not(reset_flag)) then X with py.misc do X BEGIN X exp := exp + sexp; X prt_experience; X sexp := 0; X END X END; X with py.misc do X if (not(reset_flag)) then X BEGIN X if (smana > cmana) then X BEGIN X msg_print('You faint from the effort!' V); X py.flags.paralysis := X randint(5*trunc(smana-cmana)); X cmana := 0; X if (randint(3) = 1) then X BEGIN X msg_print('You have damaged your health!') V; X py.stat.ccon := de_statp(py.stat.ccon); X prt_constitution; X END; X END X else X cmana := cmana - smana; X prt_mana; X END X END X END X else X if (redraw) then draw_cave; X END X else X msg_print('But you are not carrying any spell-books!'); X END X else X msg_print('But you are not carrying any spell-books!') X else X msg_print('You can''t cast spells!'); X END; X `20 $ CALL UNPACK [.SOURCE.INCLUDE]MAGIC.INC;1 1699855565 $ create 'f' X X X X X X`7B Use date and time to produce random seed `7D X`5Bpsect(setup$code)`5D function get_seed : unsigned; X type X $quad = `5Bquad,unsafe`5D record X l0 : unsigned; X l1 : unsigned; X end; X var X time : $quad; X seed_val : unsigned; X`20 X `5Basynchronous,external (SYS$GETTIM)`5D function get_time( X var time : $quad) : integer; X external; X`20 X begin X get_time(time); `7B Current time `7D X seed_val := uor(time.l0,time.l1); `7B Random number `7D X get_seed := uor(seed_val,%X'00000001'); `7B Odd number `7D X end; X`20 X`20 X`7B Computes current weight limit `7D X`5Bpsect(misc4$code)`5D function weight_limit : integer; X var X weight_cap : integer; X begin X weight_cap := py.stat.cstr*player_weight_cap + py.misc.wt; X if (weight_cap > 3000) then weight_cap := 3000; X weight_limit := weight_cap; X end; X`20 X`20 X`7B Returns the day number; 1=Sunday...7=Saturday `7D X`5Bpsect(setup$code)`5D function day_num : integer; X var `20 X i1 : integer; X `5Bexternal(LIB$DAY)`5D function day( X var daynum : integer; X dum1 : integer := %immed 0; X dum2 : integer := %immed 0) : integer; X external; X begin X day(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-1) and X (x > 1) and (x < cur_width-1)) 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; X i2 := 0; X i3 := max_creatures - win_mon_tot; X repeat `20 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; `20 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 (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 else if (tptr > 0) then X sym := t_list`5Btptr`5D.tchar X else if (fval < 10) then X sym := '.' X else X sym := '#'; X end X else if (tptr > 0) then X sym := t_list`5Btptr`5D.tchar X else if (fval < 10) then X sym := '.' X else X sym := '#'; 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; `20 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 +-+-+-+-+-+-+-+- END OF PART 29 +-+-+-+-+-+-+-+-