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