-+-+-+-+-+-+-+-+ START OF PART 24 -+-+-+-+-+-+-+-+ Xwriteln(file1,' Cur Hit Points :',trunc(py.misc.chp):6,error:=continue); Xwrite(file1, ' + To AC :',py.misc.dis_tac:6,error:=continue); Xwrite(file1, ' Gold :',py.misc.au:6,error:=continue); Xwriteln(file1,' Max Mana :',py.misc.mana:6,error:=continue); Xwrite(file1, ' Total AC :',py.misc.dis_ac:6,error:=continue); Xwrite(file1, ' ',error:=continue); Xwriteln(file1,' Cur Mana :',py.misc.mana:6,error:=continue); X X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 with py.misc do X`09`09begin X`09`09 xbth := bth + lev*bth_lev_adj + ptohit*bth_plus_adj; X`09`09 xbthb := bthb + lev*bth_lev_adj + ptohit*bth_plus_adj; X`09`09 xfos := 27 - fos; X`09`09 if (xfos < 0) then xfos := 0; X`09`09 xsrh := srh + int_adj; X`09`09 xstl := stl; X`09`09 xdis := disarm + lev + 2*todis_adj + int_adj; X`09`09 xsave := save + lev + wis_adj; X`09`09 xdev := save + lev + int_adj; X`09`09 writev(xinfra,py.flags.see_infra*10:1,' feet'); X`09`09end; Xwriteln(file1,'(Miscellaneous Abilities)':40,error:=continue); Xwriteln(file1,' ',error:=continue); Xwrite(file1, ' Fighting : ',pad(likert(xbth ,12),' ',10),error:=continu Ve); Xwrite(file1, ' Stealth : ',pad(likert(xstl , 1),' ',10),error:=continu Ve); Xwriteln(file1,' Perception : ',pad(likert(xfos , 3),' ',10),error:=continu Ve); Xwrite(file1, ' Throw/Bows : ',pad(likert(xbthb,12),' ',10),error:=continu Ve); Xwrite(file1, ' Disarming : ',pad(likert(xdis , 8),' ',10),error:=continu Ve); Xwriteln(file1,' Searching : ',pad(likert(xsrh , 6),' ',10),error:=continu Ve); Xwrite(file1, ' Saving Throw: ',pad(likert(xsave, 6),' ',10),error:=continu Ve); Xwrite(file1, ' Magic Device: ',pad(likert(xdev , 7),' ',10),error:=continu Ve); Xwriteln(file1,' Infra-Vision: ',pad(xinfra,' ',10),error:=continue); X`09`7B Write out the character's history`09`7D Xwriteln(file1,' '); Xwriteln(file1,' '); Xwriteln(file1,'Character Background':45); Xfor i1 := 1 to 5 do writeln(file1,pad(py.misc.history`5Bi1`5D,' ',71):76); X`09`7B Write out the equipment list...`09`7D X`09 i2 := 0; X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' `5BCharacter''s Equipment List`5D',error:=continue V); X`09 writeln(file1,' ',error:=continue); Xif (equip_ctr = 0) then X writeln(file1,' Character has no equipment in use.',error:=continue) Xelse X for i1 := 23 to inven_max-1 do X with inventory`5Bi1`5D do X if (tval > 0) then X`09begin X`09 case i1 of X`09 23 :`09prt1 := ') You are wielding : '; X`09 24 :`09prt1 := ') Worn on head : '; X`09 25 :`09prt1 := ') Worn around neck : '; X`09 26 :`09prt1 := ') Worn on body : '; X`09 27 :`09prt1 := ') Worn on shield arm : '; X`09 28 :`09prt1 := ') Worn on hands : '; X`09 29 :`09prt1 := ') Right ring finger : '; X`09 30 :`09prt1 := ') Left ring finger : '; X`09 31 :`09prt1 := ') Worn on feet : '; X`09 32 :`09prt1 := ') Worn about body : '; X`09 33 :`09prt1 := ') Light source is : '; X`09 34 :`09prt1 := ') Secondary weapon : '; X`09 otherwise prt1 := ') *Unknown value* : '; X`09 end; X`09 i2 := i2 + 1; X`09 objdes(prt2,i1,true); X`09 writev(out_val,' ',chr(i2+96),prt1,prt2); X`09 writeln(file1,out_val,error:=continue); X`09end; X`09`7B Write out the character's inventory...`09`7D X`09 writeln(file1,new_page,error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' ',error:=continue); X`09 writeln(file1,' `5BGeneral Inventory List`5D',error:=continue); X`09 writeln(file1,' ',error:=continue); Xif (inven_ctr = 0) then X writeln(file1,' Character has no objects in inventory.',error:=continue) Xelse X begin X for i1 := 1 to inven_ctr do X begin X`09objdes(prt1,i1,true); X`09writev(out_val,chr(i1+96),') ',prt1); X`09writeln(file1,out_val,error:=continue); X end X end; X`09 writeln(file1,new_page,error:=continue); X`09 close(file1,error:=continue); X`09 prt('Completed.',1,1); X`09 end; X`09end X end; $ CALL UNPACK [.SOURCE.INCLUDE]FILES.INC;1 576378223 $ create 'f' X`09`7B Generates a random dungeon level`09`09`09-RAK-`09`7D X`5Bpsect(generate$code)`5D procedure generate_cave; X type X`09coords = record X`09`09y`09: integer; X`09`09x`09: integer; X`09end; X var X`09doorstk`09`09`09: array `5B1..100`5D of coords; X`09doorptr`09`09`09: integer; X X X`09`7B Always picks a correct direction`09`09`7D X procedure correct_dir(var rdir,cdir : integer; y1,x1,y2,x2 : integer); X`09var X`09`09test_dir`09: integer; X`09begin X`09 if (y1 < y2) then X`09 rdir := 1 X`09 else if (y1 = y2) then X`09 rdir := 0 X`09 else X`09 rdir := -1; X`09 if (x1 < x2) then X`09 cdir := 1 X`09 else if (x1 = x2) then X`09 cdir := 0 X`09 else X`09 cdir := -1; X`09 if ((rdir <> 0) and (cdir <> 0)) then X`09 case randint(2) of X`09`091 :`09rdir := 0; X`09`092 :`09cdir := 0 X`09 end X`09end; X X X`09`7B Chance of wandering direction`09`09`09`7D X procedure rand_dir(var rdir,cdir : integer;`20 X`09`09`09 y1,x1,y2,x2,chance : integer); X`09begin X`09 case randint(chance) of X`09`091 :`09begin X`09`09`09 rdir := -1; X`09`09`09 cdir := 0 X`09`09`09end; X`09`092 :`09begin X`09`09`09 rdir := 1; X`09`09`09 cdir := 0 X`09`09`09end; X`09`093 :`09begin X`09`09`09 rdir := 0; X`09`09`09 cdir := -1 X`09`09`09end; X`09`094 :`09begin X`09`09`09 rdir := 0; X`09`09`09 cdir := 1 X`09`09`09end; X`09`09otherwise correct_dir(rdir,cdir,y1,x1,y2,x2) X`09 end X`09end; X `20 X X`09`7B Blanks out entire cave`09`09`09`09-RAK-`09`7D X procedure blank_cave; X var X`09i1,i2`09: integer; X begin X for i1 := 1 to max_height do X`09 for i2 := 1 to max_width do X`09 cave`5Bi1,i2`5D := blank_floor; X end; X X X`09`7B Fills in empty spots with desired rock`09`09-RAK-`09`7D X`09`7B Note: 9 is a temporary value.`09`09`09`09`7D X procedure fill_cave(fill : floor_type); X var X`09i1,i2`09: integer; X begin X for i1 := 2 to cur_height-1 do X`09 for i2 := 2 to cur_width-1 do X`09 with cave`5Bi1,i2`5D do X`09 if (fval in `5B0,8,9`5D) then X`09 begin X`09`09 fval := fill.ftval; X`09`09 fopen := fill.ftopen; X`09 end; X end; X X X`09`7B Places indestructable rock around edges of dungeon`09-RAK-`09`7D X procedure place_boundry; X var X`09i1`09: integer; X begin X`09for i1 := 1 to cur_height do X`09 begin X`09 cave`5Bi1,1`5D.fval := boundry_wall.ftval; X`09 cave`5Bi1,1`5D.fopen := boundry_wall.ftopen; X`09 cave`5Bi1,cur_width`5D.fval := boundry_wall.ftval; X`09 cave`5Bi1,cur_width`5D.fopen := boundry_wall.ftopen; X`09 end; X`09for i1 := 1 to cur_width do X`09 begin X`09 cave`5B1,i1`5D.fval := boundry_wall.ftval; X`09 cave`5B1,i1`5D.fopen := boundry_wall.ftopen; X`09 cave`5Bcur_height,i1`5D.fval := boundry_wall.ftval; X`09 cave`5Bcur_height,i1`5D.fopen := boundry_wall.ftopen; X`09 end; X end; X X X`09`7B Places "streamers" of rock through dungeon`09`09-RAK-`09`7D X procedure place_streamer(rock : floor_type; treas_chance : integer); X var X`09i1,y,x,dir,ty,tx,t1,t2`09`09: integer; X`09flag`09`09`09`09: boolean; X begin X X`09`7B Choose starting point and direction`09`09`7D X`09y := trunc(cur_height/2.0) + 11 - randint(23); X`09x := trunc(cur_width/2.0) + 16 - randint(33); X X`09dir := randint(8);`09`7B Number 1-4, 6-9`09`7D X`09if (dir > 4) then dir := dir + 1; X X`09`7B Place streamer into dungeon`09`09`09`7D X`09flag := false;`09`7B Set to true when y,x are out-of-bounds`7D X`09t1 := 2*dun_str_rng + 1;`09`7B Constants`09`7D X`09t2 := dun_str_rng + 1; X`09repeat X`09 for i1 := 1 to dun_str_den do X`09 begin X`09 ty := y + randint(t1) - t2; X`09 tx := x + randint(t1) - t2; X`09 if (in_bounds(ty,tx)) then X`09 with cave`5Bty,tx`5D do X`09`09 if (fval = rock_wall1.ftval) then X`09`09 begin X`09`09 fval := rock.ftval; X`09`09 fopen := rock.ftopen; X`09`09 if (randint(treas_chance) = 1) then X`09`09 place_gold(ty,tx); X`09`09 end; X`09 end; X`09 if (not(move(dir,y,x))) then flag := true; X`09until(flag); X end; X X X`09`7B Place a trap with a given displacement of point`09-RAK-`09`7D X procedure vault_trap(y,x,yd,xd,num : integer); X var X`09count,y1,x1,i1`09`09: integer; X`09flag`09`09`09: boolean; X begin X`09for i1 := 1 to num do X`09 begin X`09 flag := false; X`09 count := 0; X`09 repeat X`09 y1 := y - yd - 1 + randint(2*yd+1); X`09 x1 := x - xd - 1 + randint(2*xd+1); X`09 with cave`5By1,x1`5D do X`09 if (fval in floor_set) then X`09 if (tptr = 0) then X`09`09 begin X`09`09 place_trap(y1,x1,1,randint(max_trapa)); X`09`09 flag := true; X`09`09 end; X`09 count := count + 1; X`09 until((flag) or (count > 5)); X`09 end; X end; X X X`09`7B Place a trap with a given displacement of point`09-RAK-`09`7D X procedure vault_monster(y,x,num : integer); X var X`09`09i1,y1,x1`09`09: integer; X begin X`09for i1 := 1 to num do X`09 begin X`09 y1 := y; X`09 x1 := x; X`09 summon_monster(y1,x1,true); X`09 end; X end; X X X`09`7B Builds a room at a row,column coordinate`09`09-RAK-`09`7D X procedure build_room(yval,xval : integer); X var X`09`09y_height,y_depth`09: integer; X`09`09x_left,x_right`09`09: integer; X`09`09i1,i2`09`09`09: integer; X`09`09cur_floor`09`09: floor_type; X begin X`09if (dun_level <= randint(25)) then X`09 cur_floor := lopen_floor`09`7B Floor with light`09`7D X`09else X`09 cur_floor := dopen_floor;`09`7B Dark floor`09`09`7D X`09y_height := yval - randint(4); X`09y_depth := yval + randint(3); X`09x_left := xval - randint(11); X`09x_right := xval + randint(11); X`09for i1 := y_height to y_depth do X`09 for i2 := x_left to x_right do X`09 begin X`09 cave`5Bi1,i2`5D.fval := cur_floor.ftval; X`09 cave`5Bi1,i2`5D.fopen := cur_floor.ftopen; X`09 end; X`09for i1 := (y_height - 1) to (y_depth + 1) do X`09 begin X`09 cave`5Bi1,x_left-1`5D.fval := rock_wall1.ftval; X`09 cave`5Bi1,x_left-1`5D.fopen := rock_wall1.ftopen; X`09 cave`5Bi1,x_right+1`5D.fval := rock_wall1.ftval; X`09 cave`5Bi1,x_right+1`5D.fopen := rock_wall1.ftopen; X`09 end; X`09for i1 := x_left to x_right do X`09 begin X`09 cave`5By_height-1,i1`5D.fval := rock_wall1.ftval; X`09 cave`5By_height-1,i1`5D.fopen := rock_wall1.ftopen; X`09 cave`5By_depth+1,i1`5D.fval := rock_wall1.ftval; X`09 cave`5By_depth+1,i1`5D.fopen := rock_wall1.ftopen; X`09 end X end; X X X`09`7B Builds a room at a row,column coordinate`09`09-RAK-`09`7D X`09`7B Type 1 unusual rooms are several overlapping rectangular ones`09`7D X procedure build_type1(yval,xval : integer); X var X`09`09y_height,y_depth`09: integer; X`09`09x_left,x_right`09`09: integer; X`09`09i0,i1,i2`09`09: integer; X`09`09cur_floor`09`09: floor_type; X begin X`09if (dun_level <= randint(25)) then X`09 cur_floor := lopen_floor`09`7B Floor with light`09`7D X`09else X`09 cur_floor := dopen_floor;`09`7B Dark floor`09`09`7D X`09for i0 := 1 to (1 + randint(2)) do X`09 begin X`09 y_height := yval - randint(4); X`09 y_depth := yval + randint(3); X`09 x_left := xval - randint(11); X`09 x_right := xval + randint(11); X`09 for i1 := y_height to y_depth do X`09 for i2 := x_left to x_right do X`09`09begin X`09`09 cave`5Bi1,i2`5D.fval := cur_floor.ftval; X`09`09 cave`5Bi1,i2`5D.fopen := cur_floor.ftopen; X`09`09end; X`09 for i1 := (y_height - 1) to (y_depth + 1) do X`09 begin X`09`09with cave`5Bi1,x_left-1`5D do X`09`09 if (fval <> cur_floor.ftval) then X`09`09 begin X`09`09 fval := rock_wall1.ftval; X`09`09 fopen := rock_wall1.ftopen; X`09`09 end; X`09`09with cave`5Bi1,x_right+1`5D do X`09`09 if (fval <> cur_floor.ftval) then X`09`09 begin X`09`09 fval := rock_wall1.ftval; X`09`09 fopen := rock_wall1.ftopen; X`09`09 end; X`09 end; X`09 for i1 := x_left to x_right do X`09 begin X`09`09with cave`5By_height-1,i1`5D do X`09`09 if (fval <> cur_floor.ftval) then X`09`09 begin X`09`09 fval := rock_wall1.ftval; X`09`09 fopen := rock_wall1.ftopen; X`09`09 end; X`09`09with cave`5By_depth+1,i1`5D do X`09`09 if (fval <> cur_floor.ftval) then X`09`09 begin X`09`09 fval := rock_wall1.ftval; X`09`09 fopen := rock_wall1.ftopen; X`09`09 end; X`09 end; X`09 end; X end; X X X`09`7B Builds an unusual room at a row,column coordinate`09-RAK-`09`7D X`09`7B Type 2 unusual rooms all have an inner room:`09`09`09`7D X`09`7B 1 - Just an inner room with one door`09`09`09`7D X`09`7B 2 - An inner room within an inner room`09`09`09`7D X`09`7B 3 - An inner room with pillar(s)`09`09`09`09`7D X`09`7B 4 - Inner room has a maze`09`09`09`09`09`7D X`09`7B 5 - A set of four inner rooms`09`09`09`09`7D X procedure build_type2(yval,xval : integer); X var X`09`09y_height,y_depth`09: integer; X`09`09x_left,x_right`09`09: integer; X`09`09i1,i2`09`09`09: integer; X`09`09cur_floor`09`09: floor_type; X begin X`09if (dun_level <= randint(30)) then X`09 cur_floor := lopen_floor`09`7B Floor with light`09`7D X`09else X`09 cur_floor := dopen_floor;`09`7B Dark floor`09`09`7D X`09y_height := yval - 4; X`09y_depth := yval + 4; X`09x_left := xval - 11; X`09x_right := xval + 11; X`09for i1 := y_height to y_depth do X`09 for i2 := x_left to x_right do X`09 begin X`09 cave`5Bi1,i2`5D.fval := cur_floor.ftval; X`09 cave`5Bi1,i2`5D.fopen := cur_floor.ftopen; X`09 end; X`09for i1 := (y_height - 1) to (y_depth + 1) do X`09 begin X`09 cave`5Bi1,x_left-1`5D.fval := rock_wall1.ftval; X`09 cave`5Bi1,x_left-1`5D.fopen := rock_wall1.ftopen; X`09 cave`5Bi1,x_right+1`5D.fval := rock_wall1.ftval; X`09 cave`5Bi1,x_right+1`5D.fopen := rock_wall1.ftopen; X`09 end; X`09for i1 := x_left to x_right do X`09 begin +-+-+-+-+-+-+-+- END OF PART 24 +-+-+-+-+-+-+-+-