-+-+-+-+-+-+-+-+ START OF PART 30 -+-+-+-+-+-+-+-+
X`09  if (not(move(dir,y,x))) then flag := true;
X`09until(flag);
X      end;
X
X
X    procedure all_the_river_stuff;
X      type
X`09river_deal = record
X`09  in1,in2,out`09: integer; `7B (keypad) directions; in is upstream `7D
X`09  flow`09`09: integer; `7B water flow out of this river spot `7D
X`09  pos`09`09: integer; `7B in array of s_l_type; if > num_left then `7D
X`09`09`09`09   `7B spot is no longer available `7D
X`09end;
X
X`09s_l_type = record
X`09  loc`09`09: coords; `7B cross-ref back to river_deal `7D
X`09  is_active`09: boolean;`7B is still an unresolved river source`7D
X`09end;
X
X      const
X`09size_y = 10;
X`09size_x = 31;
X`09total_size = 310;
X`09segment_size = 6;
X
X      var
X`09  gup`09`09: array `5B1..size_y`5D of array `5B1..size_x`5D of river_deal
V;
X`09  s_list`09: array `5B1..total_size`5D of s_l_type;
X`09  num_left,s_l_top`09: integer;
X`09  max_wet`09: integer; `7B # of river or next-to-river `7D
X`09  i1,i2`09`09: integer;
X`09  river_mouth`09: coords;
X`09  out_str`09: string;
X
X`09`7B returns position of (this + dir) in gup or this if out of bounds `7D
X`09function move_this(dir : integer; this : coords; var that : coords) : boo
Vlean;
X`09  begin
X`09    move_this := false;
X`09    that.y := this.y + dy_of`5Bdir`5D;
X`09    that.x := this.x + dx_of`5Bdir`5D;
X`09    if (that.y in `5B1..size_y`5D) and (that.x in `5B1..size_x`5D) then
X`09      move_this := true
X`09    else`09`7Breset to legal value`7D
X`09      that := this;
X`09  end;
X
X
X`09`7Bmake gup`5Bthis`5D unavailable (for later selection), decrement num_le
Vft`7D
X`09procedure remove_this(this : coords);
X`09  var i1`09: integer;
X`09      that`09: coords;
X`09      last`09: s_l_type;
X `09  begin
X`09    with gup`5Bthis.y,this.x`5D do
X`09     if (pos <= num_left) then `7Bif gup`5Bthis`5D.pos is still available
V`7D
X`09      begin
X`09`09last := s_list`5Bnum_left`5D;  `7Bswitch gup`5Bthis`5D.pos with top el
Vmt`7D
X`09`09s_list`5Bnum_left`5D := s_list`5Bpos`5D;
X`09`09s_list`5Bpos`5D := last;
X`09`09gup`5Blast.loc.y,last.loc.x`5D.pos := pos;
X`09`09pos := num_left;
X`09`09num_left := num_left - 1;  `7Bpop gup`5Bthis`5D.pos`7D
X`09      end;
X`09  end;
X
X`09procedure plot_water(y,x : integer; font,tdir : integer);
X`09  var
X`09`09num_dots`09: integer;
X`09`09dots`09`09: array `5B1..5`5D of coords;
X`09`09i1`09`09: integer;
X`09    begin
X`09      dots`5B1`5D.y := y;
X`09      dots`5B1`5D.x := x;
X`09      case font of
X`09`090 : num_dots := 1;
X`09`091 : begin
X`09`09      num_dots := 2;
X`09`09      dots`5B2`5D.y := y + dx_of`5Btdir`5D;
X`09`09      dots`5B2`5D.x := x - dy_of`5Btdir`5D;
X`09`09    end;
X`09`09otherwise
X`09`09      begin
X`09`09`09num_dots := 5;
X`09`09`09for i1 := 1 to 4 do
X`09`09`09  begin
X`09`09`09    dots`5Bi1+1`5D.y := y + dy_of`5B2*i1`5D;
X`09`09`09    dots`5Bi1+1`5D.x := x + dx_of`5B2*i1`5D;
X`09`09`09  end;
X`09`09      end;
X`09      end;
X`09      for i1 := 1 to num_dots do
X`09`09if in_bounds(dots`5Bi1`5D.y,dots`5Bi1`5D.x) then
X`09`09  with cave`5Bdots`5Bi1`5D.y,dots`5Bi1`5D.x`5D do
X`09`09  begin
X`09`09    if (fval in `5B1,2`5D) then
X`09`09      begin
X`09`09`09fval := water2.ftval;
X`09`09`09fopen := water2.ftopen;
X`09`09      end
X`09`09    else
X`09`09      begin
X`09`09`09fval := water1.ftval;
X`09`09`09fopen := water1.ftopen;
X`09`09      end;
X`09`09    h2o := 1;
X`09`09    if (tptr <> 0) and (t_list`5Btptr`5D.tval > valuable_metal)
X`09`09`09 then
X`09`09      begin
X`09`09`09pusht(tptr);
X`09`09`09tptr := 0;
X`09`09      end;
X`09`09  end `7B with cave `7D
X`09    end;
X
X`7B A recursive procedure, starting at river mouth and moving upstream; conn
Vects
X  the dots laid out by chart_river. `7D
X
X      procedure place_river(dir,next_dir : integer; this,wiggle : coords);
X       var
X`09i1,i2,y,x,oy,ox`09`09: integer;
X`09temp_dir,done_first`09: integer; `7B compute next direction `7D
X`09up1,up2`09`09`09: coords;
X`09tflow`09`09`09: integer;
X
X       function figure_out_path_of_water : integer;
X`09var`20
X`09 target_dy,target_dx,dist_squared`09: integer;
X`09 i1,dot_product,rand_num,chance`09`09: integer;
X`09 start`09: array `5B0..8`5D of integer;
X`09 flag`09: boolean;
X`09begin
X`09  target_dy := y - oy;
X`09  target_dx := x - ox;
X`09  dist_squared := target_dy * target_dy + target_dx * target_dx;
X`09  start`5B0`5D := 1;
X`09  for i1 := 0 to 7 do`09`7Boctant number`7D
X`09    begin
X`09      dot_product := target_dy*dy_of`5Bkey_of`5Bi1`5D`5D + target_dx*dx_o
Vf`5Bkey_of`5Bi1`5D`5D;
X`09`7Bformula subtracts dist_squared to keep stream semi-normal`7D
X`09`7Bdiagonals give root2 inflated dot_products`7D
X`09      if (dot_product > 0) then
X`09`09if i1 in `5B1,3,5,7`5D then
X`09`09  chance := dot_product * dot_product * 2 - dist_squared
X`09`09else
X`09`09  chance := dot_product * dot_product * 4 - dist_squared
X`09      else
X`09`09chance := 0;
X`09      if (chance > 0) then
X`09`09start`5Bi1+1`5D := start`5Bi1`5D + chance
X`09      else
X`09`09start`5Bi1+1`5D := start`5Bi1`5D;
X`09    end;
X`09`7Bchoose random directions; chances partitioned by start`5B`5D`7D
X`09  rand_num := randint(start`5B8`5D - 1);
X`09  flag := false;
X`09  i1 := -1;
X`09  repeat
X`09    i1 := i1 + 1;
X`09    flag := (start`5Bi1 + 1`5D > rand_num);
X`09  until (flag);
X`09  figure_out_path_of_water := key_of`5Bi1`5D;
X`09end;
X
X       begin
X`09move_this(dir,this,up1);`09`7Bup1 is upstream end of segment`7D
X`09move_this(next_dir,up1,up2);`09`7Bup2 is upstream end of next segment`7D
X`09tflow := (gup`5Bup2.y,up2.x`5D.flow - 1) div 2;`09`7Briver size`7D
X`09`09`7Baim (y,x) toward upstream end of segment, randomize slightly`7D
X`09oy := segment_size * this.y + wiggle.y;
X`09ox := segment_size * this.x + wiggle.x;
X`09if (dir <> next_dir) then
X`09  begin
X`09    i1 := oct_of`5Bnext_dir`5D - oct_of`5Bdir`5D; `7B (1=left, -1 = right
V) mod 8`7D
X`09    if (oct_of`5Bdir`5D mod 2 = 0) then
X`09      i2 := rotate_dir(next_dir,i1)
X`09    else
X`09      i2 := rotate_dir(next_dir,2*i1);
X`09    wiggle.y := dy_of`5Bi2`5D + (randint(3) - 2);
X`09    wiggle.x := dx_of`5Bi2`5D + (randint(3) - 2);
X`09  end;
X`09i1 := 0;
X`09y := segment_size*up1.y+wiggle.y; `7By,x=(upstream) destination of river`
V7D
X`09x := segment_size*up1.x+wiggle.x;
X`09while ((oy <> y) or (ox <> x)) do
X`09 begin
X`09  temp_dir := figure_out_path_of_water;
X`09  if (temp_dir) in `5B2,4,6,8`5D then
X`09    begin
X`09      move(temp_dir,oy,ox);
X`09      plot_water(oy,ox,tflow,temp_dir);
X`09    end
X`09  else
X`09    begin
X`09      if (randint(2) = 1) then
X`09`09done_first := 1
X`09      else
X`09`09done_first := -1;
X`09      move(rotate_dir(temp_dir,done_first),oy,ox);
X`09      plot_water(oy,ox,tflow,temp_dir);
X`09      move(rotate_dir(temp_dir,-done_first),oy,ox);
X`09      plot_water(oy,ox,tflow,temp_dir);
X`09    end;
X`09 end;
X`09`09`7Bbranch rivers 1 move early to make branching more gradual`7D
X`09with gup`5Bup2.y,up2.x`5D do
X`09  begin
X`09    if (in1 <> 5) then
X`09      place_river(next_dir,in1,up1,wiggle);
X`09    if (in2 <> 5) then
X`09      place_river(next_dir,in2,up1,wiggle);
X`09  end;
X      end;
X
X`09   `20
X`7B recursively charts basic path of stream upstream `7D
X`09procedure chart_river;
X`09  var i1,i2,dir,branches`09: integer;
X`09      out_flow,in_flow`09`09: integer;
X`09      this,thing`09`09: coords;
X`09      that`09`09`09: array `5B1..3`5D of coords;
X`09      that_dir`09`09`09: array `5B1..3`5D of integer;
X`09      that_ok,that_chosen`09: array `5B1..3`5D of boolean;
X`09      starting_river`09`09: boolean;
X
X
X`7Bdetermines next point(s) upstream depending on coordinates (this), previo
Vus
X direction (gup`5Bthis`5D.out), and available positions. outputs # of branch
Ves`7D
X`09  function choose_stream_dirs(var this : coords) : integer;
X`09    var i1`09: integer;
X`09      done`09: boolean;
X`09    begin
X`09      this := s_list`5Bs_l_top`5D.loc;
X`09      dir := gup`5Bthis.y,this.x`5D.out;
X`09      for i1 := 1 to 3 do`09`7Bleft,straight,right`7D
X`09`09begin
X`09`09  that_dir`5Bi1`5D := rotate_dir(dir,2-i1);
X`09`09  that_ok`5Bi1`5D := move_this(that_dir`5Bi1`5D,this,that`5Bi1`5D);
X`09`09  if that_ok`5Bi1`5D then
X`09`09    that_ok`5Bi1`5D := gup`5Bthat`5Bi1`5D.y,that`5Bi1`5D.x`5D.pos <= n
Vum_left;
X`09`09  that_chosen`5Bi1`5D := false;
X`09`09end;
X`09      done := false;
X`09      if ((randint(3*gup`5Bthis.y,this.x`5D.flow) = 1) or
X`09`09 not (that_ok`5B1`5D or that_ok`5B2`5D or that_ok`5B3`5D)) then
X`09`09begin  `7Bend stream if blocked or small river and random`7D
X`09`09  done := true;
X`09`09  choose_stream_dirs := 0;
X`09`09end
X`09      else if (((randint(5) = 1) or not (that_ok`5B1`5D or that_ok`5B3`5D
V))
X`09      and that_ok`5B2`5D) then
X`09`09begin`09`7Bstraight stream (1/5 and ok) or sides blocked`7D
X`09`09  done := true;
X`09`09  that_chosen`5B2`5D := true;
X`09`09  choose_stream_dirs := 1;
X`09`09end
X`09      else if ((randint(5) = 1) and (that_ok`5B1`5D and that_ok`5B3`5D))
V then
X`09`09begin`09`7Bfork 1/5 and both sides ok`7D
X`09`09  done := true;
X`09`09  that_chosen`5B1`5D := true;
X`09`09  that_chosen`5B3`5D := true;
X`09`09  choose_stream_dirs := 2;
X`09`09end;
X`09      if (not done) then`09`7B 1 or 3 must be open `7D`20
X`09`09`7Bcheck 1 side first; if it fails, second must be true`7D
X`09`09begin
X`09`09  i1 := 2*randint(2) - 1;
X`09`09  that_chosen`5Bi1`5D := that_ok`5Bi1`5D;
X`09`09  that_chosen`5B4-i1`5D := not that_chosen`5Bi1`5D;
X`09`09  choose_stream_dirs := 1;
X`09`09end;
X`09`09`7Bno rivers adjacent each other (except connected segments)`7D
X`09    end;
X
X`09`7Bget highest unresolved river segment; s_l_top points to new segment
X`09 if any is found. `7D
X`09  function dequeue_s_list : boolean;
X`09    begin
X`09      while ((s_l_top > num_left) and (not s_list`5Bs_l_top`5D.is_active)
V) do
X`09`09s_l_top := s_l_top - 1;
X`09      if (s_l_top > num_left) then
X`09`09begin
X`09`09  s_list`5Bs_l_top`5D.is_active := false;
X`09`09  dequeue_s_list := true;
X`09`09end
X`09      else
X`09`09dequeue_s_list := false;
X`09    end;`09
X
X`09  begin `7B chart_river `7D
X`09    starting_river := true;
X`09    remove_this(s_list`5Brandint(num_left)`5D.loc);`7Belement is now s_l_
Vtop`7D
X`09    s_list`5Bs_l_top`5D.is_active := true;
X`09    this := s_list`5Bs_l_top`5D.loc;
X`09    gup`5Bthis.y,this.x`5D.flow := 4+randint(3);
X`09    river_mouth := this;
X`09    for i1 := 1 to 3 do
X`09      that_chosen`5Bi1`5D := false;
X`09    i1 := 0;
X`09    repeat`09`09`7B choose initial heading, in streams `7D
X`09      dir := randint(8);
X`09      if (dir = 5) then
X`09`09dir := 9;
X`09      i1 := i1 + 1;
X`09      if move_this(dir,this,that`5B2`5D) then
X`09`09that_chosen`5B2`5D := gup`5Bthat`5B2`5D.y,that`5B2`5D.x`5D.pos <= num_
Vleft;
X`09    until ((that_chosen`5B2`5D) or (i1 >= 10));
X`09    that_dir`5B2`5D := dir;
X`09    that_ok`5B2`5D := true;
X`09    branches := 1;
X`09    while dequeue_s_list do`09`7Bloop until river stops`7D
X`09      begin
X`09`09if starting_river then
X`09`09  starting_river := false
X`09`09else
X`09`09  branches := choose_stream_dirs(this);
X`09      for i1 := 1 to 9 do`20
X`09`09  if move_this(i1,this,thing) then
X`09`09    remove_this(thing);
X`09      if (that_chosen`5B1`5D) then`09`7B No sharp left turns `7D
X`09`09begin`09
X`09`09  move_this(rotate_dir(dir,1),this,thing);
X`09`09  if move_this(rotate_dir(dir,2),thing,thing) then
X`09`09    remove_this(thing)
X`09`09end;
X`09      if (that_chosen`5B3`5D) then  `7B No sharp right turns `7D
X`09`09begin
X`09`09  move_this(rotate_dir(dir,-1),this,thing);
X`09`09  if move_this(rotate_dir(dir,-2),thing,thing) then
X`09`09    remove_this(thing)
X`09`09end;
X`09`09out_flow := gup`5Bthis.y,this.x`5D.flow;
X`09`09i2 := 1;
X`09`09for i1 := 1 to 3 do
X`09`09  if (that_chosen`5Bi1`5D and (total_size-num_left<max_wet)) then
X`09`09    begin
X`09`09      if (branches = 1) then
X`09`09`09in_flow := out_flow
X`09`09      else
X`09`09`09in_flow := out_flow - randint(2);
X`09`09      if (in_flow > 0) then
X`09`09`09with gup`5Bthat`5Bi1`5D.y,that`5Bi1`5D.x`5D do
X`09`09`09  begin
X`09`09            if (i2 = 1) then
X`09`09`09      gup`5Bthis.y,this.x`5D.in1 := that_dir`5Bi1`5D
X`09`09            else
X`09`09`09      gup`5Bthis.y,this.x`5D.in2 := that_dir`5Bi1`5D;
X`09`09`09    s_list`5Bpos`5D.is_active := true;
X`09`09`09    out := that_dir`5Bi1`5D;
X`09`09`09    flow := in_flow;
X`09`09`09  end;
X`09`09      i2 := i2 + 1;
X`09`09    end;
X`09      end;
X`09  end;
X
X`09  procedure draw_river;
X`09    var
X`09`09first_dir`09: integer;
X`09`09wiggle,that`09: coords;
X`09    begin
X`09      wiggle.y := randint(3) - 2;
X`09      wiggle.x := randint(3) - 2;
X`09      `7BXXX place whirlpool at segment_size*river + wiggle`7D
X`09      first_dir := gup`5Briver_mouth.y,river_mouth.x`5D.in1;
X`09      move_this(first_dir,river_mouth,that);
X`09      with gup`5Bthat.y,that.x`5D do
X`09`09begin
X`09`09  if (in1 <> 5) then
X`09`09    place_river(first_dir,in1,river_mouth,wiggle);
X`09`09  if (in2 <> 5) then
X`09`09    place_river(first_dir,in2,river_mouth,wiggle);
X`09`09end;
X`09    end;
X
X
X`09  begin `7B all_the_river_stuff `7D
X`09    max_wet := randint(total_size) - 50;
X`09    if (max_wet < 0) then
X`09`09max_wet := 0;
X`09    num_left := 0;
X`09    for i1 := 1 to size_y do
X`09      for i2 := 1 to size_x do
X`09`09begin
X`09`09  num_left := num_left + 1;
X`09`09  with gup`5Bi1,i2`5D do
X`09`09   begin
X`09`09    in1 := 5;
X`09`09    in2 := 5;
X`09`09    out := 5;
X`09`09    flow := 0;
X`09`09    pos := num_left;
X`09`09   end;
X`09`09  with s_list`5Bnum_left`5D do
X`09`09   begin
X`09`09    loc.y := i1;
X`09`09    loc.x := i2;
X`09`09    is_active := false;
X`09`09   end;
X`09`09end;
X`09    for i1 := 1 to num_left do `7Bremove borders of map`7D
X`09      with s_list`5Bi1`5D do
X`09`09if (loc.y = 1) or (loc.y = size_y) or (loc.x = 1) or (loc.x = size_x)
V then
X`09`09  remove_this(loc);
X`09    s_l_top := num_left;
X`09    while (total_size - num_left < max_wet) do
X`09      begin
X`09`09chart_river;
X`09`09draw_river;
X`09      end;`09`09
X`09  end;
X
X
X`09`7B Place a pool of water, and rough up the edges`09`09-DMF-`09`7D
X    procedure place_pool(water : floor_type);
X      var
X`09i1,y,x`09: integer;
X      begin
+-+-+-+-+-+-+-+-  END  OF PART 30 +-+-+-+-+-+-+-+-