-+-+-+-+-+-+-+-+ START OF PART 34 -+-+-+-+-+-+-+-+ X`09`09 if ((failure_rate > 90) and (randint(3)=3)) then X`09`09`09 begin X`09`09`09 ident := false; X`09`09`09 first := false; X`09`09`09 msg_print('Sparks fly from the computer!'); X`09`09`09 end X else while (i1 > 0) do X begin X i2 := bit_pos(i1); X if (tval = 71) then i2 := i2 + 32; X if (first) then X if (not(i2 in `5B4,25`5D)) then X first := false; X `20 X `7B Disks... `7D X case (i2) of `20 X 1 : ident := enchant_weapon('tohit'); X 2 : ident := enchant_weapon('todam'); X 3 : ident := enchant_armor('up'); X 4 : begin X identify(inventory`5Bitem_val`5D); X msg_print('This is an identify program'); X msg_print(' '); X if (ident_spell) then first := false; X end; X 5 : if (remove_curse) then X begin X msg_print('You feel as if someone is watching over you.' V); X ident := true; X end; `20 X 6 : ident := light_area(char_row,char_col); X 7 : begin X for i3 := 1 to randint(3) do X begin X y := char_row; X x := char_col; X summon_monster(y,x,false); X end; X ident := true; X end; X 8 : begin `20 X teleport(10); X ident := true; X end; X 9 : begin X teleport(100); X ident := true; `20 X end; X 10 : begin X msg_print('That disk appeared to be blank.'); X ident := true; X end; X 11 : begin X msg_print('Your hands begin to glow.'); X py.flags.confuse_monster := true; X ident := true; X end; X 12 : ident := map_area; X 13 : ident := sleep_monsters2_3(char_row,char_col,1); X 14 : ident := warding_glyph; X 15 : ident := detect_treasure; X 16 : ident := detect_object; X 17 : ident := detect_trap; X 18 : ident := detect_sdoor; X 19 : begin X msg_print('This is a mass genocide program.'); X msg_print(' '); X ident := mass_genocide; X end; X 20 : ident := detect_invisible; X 21 : begin X ident := aggravate_monster(20); X msg_print('There is a high pitched humming noise'); X end; X 22 : ident := trap_creation; X 23 : ident := td_destroy; X 24 : ident := door_creation; X 25 : begin X identify(inventory`5Bitem_val`5D); X msg_print('This is a Recharge program.'); X msg_print(' '); X if (recharge(60)) then first := false; X end; X 26 : begin X msg_print('This is a genocide program.'); X msg_print(' '); X ident := genocide; X end; X 27 : ident := unlight_area(char_row,char_col); X 28 : ident := protect_evil; X 29 : ident := create_food; X 30 : ident := dispell_creature(%X'0008',60); X 31 : begin X msg_print('That disk appeared to be blank.'); X ident := true; X end; X X`09 32 :; `7BCursed bit- do nothing`7D X 33 :`09for i3 := 1 to randint(2) do X`09`09 ident := enchant_weapon('both'); X 34 : ident := enchant_weapon('curse'); X 35 : for i3 := 1 to randint(2) do X`09 ident := enchant_armor('up'); X 36 : ident := enchant_armor('curse'); X 37 : begin X for i3 := 1 to randint(3) do X begin X y := char_row; X x := char_col; X summon_undead(y,x); X end; X ident := true; X end; X 38 : ident := bless(randint(12)+6); X 39 : ident := bless(randint(24)+12); X 40 : ident := bless(randint(48)+24); X 41 : begin X ident := true; X py.flags.word_recall := 25 + randint(30); X msg_print('The air about you becomes charged...'); X end; X 42 : ident := destroy_area(char_row,char_col); X 43 : begin`09 X`09`09 ident := true; X`09`09 random_wierdness(0,true); X`09`09end; X 44 : begin X for i3 := 1 to randint(3) do X begin X y := char_row; X x := char_col; X summon_monster(y,x,false); X end; X ident := true; X end; X 45 : with py.flags do X`09 begin X`09`09 ident := true; X`09`09 ring_blast := 9; `7Bodd`7D X`09`09 msg_print('You are surrounded by a strange ring of fire!'); X`09`09 end;`09`09 `20 X 46 : with py.flags do X`09 begin X`09`09 ident := true; X`09`09 ring_blast := 10; `7Beven`7D X`09`09 msg_print('A strange ring of frost encircles you!'); X`09`09 end;`09`09 `20 X`7B 47..64 : msg_print('bogus disk. send bug report to max::raoul');`7 VD X otherwise msg_print('bogus disk. send bug report to max::raoul'); X end; X `7B End of Disks... `7D X end; X if (not(reset_flag)) then X begin X if (ident) then X identify(inventory`5Bitem_val`5D); X if (not(first)) then X Begin `7BDisk Eaten?`7D X`09`09`09`09if (i2 = 4) then`20 X`09`09`09`09 failure_rate := failure_rate div 2; X`09`09`09`09if (randint(100) < failure_rate) then X`09`09`09`09 begin X msg_print('Your computer eats the disk.' V); X desc_remain(item_val); X inven_destroy(item_val); X end; X`09`09`09 End; X if (flags <> 0) then X with py.misc do X begin X exp := exp + round(level/lev); X prt_experience; X end; X end; X end X else X if (redraw) then draw_cave; X end X else X msg_print('You are not carrying any disks.'); X end X`09 else`20 X`09 msg_print('But, you are not wielding a computer!') X else X msg_print('But you are not carrying anything.') X END; $ CALL UNPACK [.INC]FLOPPY.INC;1 307050322 $ create 'f' X X`7B Generates a random dungeon level `7D X`5Bpsect(generate$code)`5D procedure generate_cave; X type X coords = record X y : integer; X x : integer; X END; X var X doorstk : array `5B1..100`5D of coords; X doorptr : integer; X`09i1`09: integer;`20 X`20 X`7B Always picks a correct direction `7D X procedure correct_dir(var rdir,cdir : integer; y1,x1,y2,x2 : integer); X var X test_dir : integer; X BEGIN X if (y1 < y2) then X rdir := 1 X else if (y1 = y2) then X rdir := 0 X else X rdir := -1; X if (x1 < x2) then X cdir := 1 X else if (x1 = x2) then X cdir := 0 X else X cdir := -1; X if ((rdir <> 0) and (cdir <> 0)) then X CASE randint(2) of X 1 : rdir := 0; X 2 : cdir := 0 X END X END; X`20 X`20 X`7B Chance of wandering direction `7D X procedure rand_dir(var rdir,cdir : integer; X y1,x1,y2,x2,chance : integer); X BEGIN X CASE randint(chance) of X 1 : BEGIN X rdir := -1; X cdir := 0 X END; X 2 : BEGIN X rdir := 1; X cdir := 0 X END; X 3 : BEGIN X rdir := 0; X cdir := -1 X END; X 4 : BEGIN X rdir := 0; X cdir := 1 X END; X otherwise correct_dir(rdir,cdir,y1,x1,y2,x2) X END X END; X`20 X `7B Fills in empty spots with desired rock X Note: 9 is a temporary value. `7D X procedure fill_cave(fill : floor_type); X var X i1,i2 : integer; X BEGIN X for i1 := 2 to cur_height-1 do X for i2 := 2 to cur_width-1 do X with cave`5Bi1,i2`5D do X if (fval in `5B0,8,9`5D) then X BEGIN X fval := fill.ftval; X fopen := fill.ftopen; X END; X END; X`20 X`20 X`7B Places "streamers" of rock through dungeon `7D X procedure place_streamer(rock : floor_type; treas_chance : integer); X var X i1,y,x,dir,ty,tx,t1,t2 : integer; X flag : boolean; X BEGIN X`20 X`7B Choose starting point and direction `7D X y := trunc(cur_height/2.0) + 11 - randint(23); X x := trunc(cur_width/2.0) + 16 - randint(33); X`20 X dir := randint(8); `7B Number 1-4, 6-9 `7D X if (dir > 4) then dir := dir + 1; X`20 X`7B Place streamer into dungeon `7D X flag := false; `7B Set to true when y,x are out-of-bounds`7D X t1 := 2*dun_str_rng + 1; `7B Constants `7D X t2 := dun_str_rng + 1; X repeat X for i1 := 1 to dun_str_den do X BEGIN X ty := y + randint(t1) - t2; X tx := x + randint(t1) - t2; X if (in_bounds(ty,tx)) then X with cave`5Bty,tx`5D do X if (fval = rock_wall1.ftval) then X BEGIN X fval := rock.ftval; X fopen := rock.ftopen; X if (randint(treas_chance) = 1) then X place_gold(ty,tx); X END; X END; X if (not(move(dir,y,x))) then flag := true; X until(flag); X END; X`20 X`20 X`7B Place a trap with a given displacement of point `7D X procedure vault_trap(y,x,yd,xd,num : integer); X var X count,y1,x1,i1 : integer; X flag : boolean; X BEGIN X for i1 := 1 to num do X BEGIN X flag := false; X count := 0; X repeat X y1 := y - yd - 1 + randint(2*yd+1); X x1 := x - xd - 1 + randint(2*xd+1); X with cave`5By1,x1`5D do X if (fval in floor_set) then X if (tptr = 0) then X BEGIN X place_trap(y1,x1,1,randint(max_trapa)); X flag := true; X END; X count := count + 1; X until((flag) or (count > 5)); X END; X END; X`20 X`20 X`7B Place a monster next to the given point `7D X procedure vault_monster(y,x,num : integer); X var X i1,y1,x1 : integer; X BEGIN X for i1 := 1 to num do X BEGIN X y1 := y; X x1 := x; X summon_monster(y1,x1,true); X END; X END; X`20 X`20 X`7B Builds a room at a row,column coordinate `7D X procedure build_room(yval,xval : integer); X var X y_height,y_depth,x_left,x_right,i1,i2 : integer; X cur_floor : floor_type; X BEGIN X if (dun_level <= randint(10)) then X cur_floor := lopen_floor `7B Floor with light `7D X else X cur_floor := dopen_floor; `7B Dark floor `7D X y_height := yval - randint(4); X y_depth := yval + randint(3); X x_left := xval - randint(11); X x_right := xval + randint(11); X for i1 := y_height to y_depth do X for i2 := x_left to x_right do X BEGIN X cave`5Bi1,i2`5D.fval := cur_floor.ftval; X cave`5Bi1,i2`5D.fopen := cur_floor.ftopen; X END; X for i1 := (y_height - 1) to (y_depth + 1) do X BEGIN X cave`5Bi1,x_left-1`5D.fval := rock_wall1.ftval; X cave`5Bi1,x_left-1`5D.fopen := rock_wall1.ftopen; X cave`5Bi1,x_right+1`5D.fval := rock_wall1.ftval; X cave`5Bi1,x_right+1`5D.fopen := rock_wall1.ftopen; X END; X for i1 := x_left to x_right do X BEGIN X cave`5By_height-1,i1`5D.fval := rock_wall1.ftval; X cave`5By_height-1,i1`5D.fopen := rock_wall1.ftopen; X cave`5By_depth+1,i1`5D.fval := rock_wall1.ftval; X cave`5By_depth+1,i1`5D.fopen := rock_wall1.ftopen; X END X END; X`20 X`20 X`7B Builds a room at a row,column coordinate X Type 1 unusual rooms are several overlapping rectangular ones `7D X procedure build_type1(yval,xval : integer); X var X y_height,y_depth,x_left,x_right,i0,i1,i2 : integer; X cur_floor : floor_type; X BEGIN X if (dun_level <= randint(10)) then X cur_floor := lopen_floor `7B Floor with light `7D X else X cur_floor := dopen_floor; `7B Dark floor `7D X for i0 := 1 to (1 + randint(2)) do X BEGIN X y_height := yval - randint(4); X y_depth := yval + randint(3); +-+-+-+-+-+-+-+- END OF PART 34 +-+-+-+-+-+-+-+-