Twistier Passages

Continuing the adventure to provide a dungeon for an adventurer to adventure in, consider the problem of linking up two arbitrary (and hopefully unique) points with some sort of passage.

     0123456789
    0..........
    1.S........
    2..........
    3..........
    4.......E..

The Box Trick

Under the assumption that no walls exist, and that the passage should not be placed outside the box or rectangle created by the pair of points, the most straightforward line would be either half of that rectangle, minus the starting and ending points which presumably do not become passage points. We'll call this the box trick: draw half a box from the start to the end, and you're done.

     0123456789     0123456789
    0..........    0..........
    1.S######..    1.S........
    2.......#..    2.#........
    3.......#..    3.#........
    4.......E..    4.######E..

How did I duplicate this? "y$P" from the first column a few times works out good to duplicate the first map in vi(1), and then "R" is good to put in a run of "#" passage characters horizontally, and then "r#" and then "." to fill in the verticals. Even fancier would be to put the "y$P" into a buffer (":bu y$P" in my version of vi) and then run the buffer with "@f" which I'll usually "map g @f" for even less typing, but only when there are enough repeats to make the additional setup worthwhile. (No, "g" does not do anything in the mutated ex-vi I'm using; this is not vim.)

g isn't a vi command

However, either or both of these lines will fail if a wall prevents motion in a particular direction, here from "S" where one must move down to start the passage, and from "E" only up.

     0123456789
    0  |.......
    1-S-#####.. passage blocked by wall!
    2.......#..
    3.......#..
    4.------E-.
    5.|      |.

The free points are marked with "." to make the grid easier to see, while the blank space within the rooms is out-of-bounds for passage drawing. However, some passage drawing algorithms will simply run a passage through walls and rooms and whatever, which is an inexpensive way to ensure that all rooms link to all other rooms and as such ensure that no part of the level map (or graph) is disconnected.

One approach would be to find the free points, adjacent to the door, and then using those points as the Start and End use the box trick from above and then draw either half of the rectangle.

     0123456789     0123456789
    0  |.......    0  |.......
    1-+-.......    1-+-.......
    2.S######..    2.S........
    3.......E..    3.######E..
    4.------+-.    4.------+-.
    5.|      |.    5.|      |.

If you have a fake room point, then there are four free points; it may be necessary to restrict these to the ones closest to the other point so that the passages do not go beyond or through the fake room point. That is, some may need to restrict the passage starting points (marked with "#") to only four instead of seven in the following map. On the other hand, a fake room point presumably does not have any complicating walls (unless fake room points can be placed next to the wall of an unrelated room!) so can use the box trick directly.

     0123456789
    0.#........
    1#S#.......
    2.#........
    3.......#..
    4......#E#.

Halfrect

This maybe draws half of a rectangle, or just a line or nothing in those cases. Probably this code should be shuffled off into a well-tested module; I had wanted to do something like this algorithm during the last 7DRL challenge, and there is not time in a week for me to do such fiddly detail-oriented work (and a working game, besides) without the result being hopelessly buggy.

    #!/usr/bin/env perl
    # halfrect - draw twisty passages with rectangle halves. Assumes the
    # start, end, and points between are free of such obstacles as walls.

    use 5.36.0;
    use Curses;
    use constant {
        YY => 0,    # [y,x] points because Curses has them that way
        XX => 1,
    };

    initscr;
    noecho;
    curs_set 0;

    my ( $start, $end );
    my $running  = 1;
    my %commands = (
        c => sub { undef $start },
        q => sub { $running = 0 },
    );

    # Test that nearby points behave correctly, as there lurk off-by-ones.
    # In particular neither the 'S' nor 'E' characters should be clobbered.
    # Ideally this would be put into a test suite for a module...
    sub adjacents () {
        state $i = 0;
        state @pairs =
          ( -1, -1, -1, 0, -1, 1, 0, -1, 0, 1, 1, -1, 1, 0, 1, 1 );
        state $start = [ 1, 1 ];
        my $adjacent =
          [ $start->[YY] + $pairs[$i], $start->[XX] + $pairs[ $i + 1 ] ];
        $i += 2;
        $i = 0 if $i >= $#pairs;
        return $start, $adjacent;
    }

    while ($running) {
        unless ( defined $start ) {
            #( $start, $end ) = adjacents();
            ( $start, $end ) = two_points();
            init_conn( $start, $end );
            clear;
            addch @$start, 'S';
            addch @$end,   'E';
        }

        my $step = conn( $start, $end );
        if ( defined $step ) {
            addch @$step, '#';
        } else {
            undef $start;
        }

        my $ch = getchar;
        if ( defined $ch ) {
            my $fn = $commands{$ch};
            $fn->() if defined $fn;
        }
    }

    END { endwin }

    ########################################################################
    #
    # SUBROUTINES

    {
        my $path;

        sub conn ( $start, $end ) { shift @$path }

        sub init_conn ( $start, $end, $y_limit = $LINES, $x_limit = $COLS ) {
            $path = half_rect( $start, $end, int rand 2 );
        }
    }

    # The start and end are not included in the list of points, so the
    # caller may need to draw something there.
    sub half_rect ( $start, $end, $horizontal ) {
        my @points;
        if ( $start->[XX] == $end->[XX] and $start->[YY] == $end->[YY] ) {
            ;    # same point, no path
        } elsif ( $start->[XX] == $end->[XX] ) {
            my $dy = ( $end->[YY] - $start->[YY] ) <=> 0;
            my $y  = $start->[YY] + $dy;
            while ( $y != $end->[YY] ) {
                push @points, [ $y, $start->[XX] ];
                $y += $dy;
            }
        } elsif ( $start->[YY] == $end->[YY] ) {
            my $dx = ( $end->[XX] - $start->[XX] ) <=> 0;
            my $x  = $start->[XX] + $dx;
            while ( $x != $end->[XX] ) {
                push @points, [ $start->[YY], $x ];
                $x += $dx;
            }
        } else {
            if ($horizontal) {    # horizontal, then vertical
                my $dx     = ( $end->[XX] - $start->[XX] ) <=> 0;
                my $x      = $start->[XX] + $dx;
                my $length = abs( $end->[XX] - $x );
                while ( $length-- > 0 ) {
                    push @points, [ $start->[YY], $x ];
                    $x += $dx;
                }
                $length = $end->[YY] - $start->[YY];
                my $dy = $length <=> 0;
                my $y  = $start->[YY];
                $length = abs $length;
                while ( $length-- > 0 ) {
                    push @points, [ $y, $x ];
                    $y += $dy;
                }
            } else {    # vertical, then horizontal
                my $dy     = ( $end->[YY] - $start->[YY] ) <=> 0;
                my $y      = $start->[YY] + $dy;
                my $length = abs( $end->[YY] - $y );
                while ( $length-- > 0 ) {
                    push @points, [ $y, $start->[XX] ];
                    $y += $dy;
                }
                $length = $end->[XX] - $start->[XX];
                my $dx = $length <=> 0;
                my $x  = $start->[XX];
                $length = abs $length;
                while ( $length-- > 0 ) {
                    push @points, [ $y, $x ];
                    $x += $dx;
                }
            }
        }
        return \@points;
    }

    sub two_points ( $y_limit = $LINES, $x_limit = $COLS ) {
        my ( @p, @d );
        @p = map int, rand($y_limit), rand($x_limit);
        do {
            @d = map int, rand($y_limit), rand($x_limit);
        } while ( $p[XX] == $d[XX] and $p[YY] == $d[YY] );
        return \@p, \@d;
    }

=> halfrect.pl

More Twisty

However, these passages are not very twisty, inasmuch as a particular stride is not very silly. Mostly you get exactly one bend, except for various degenerate cases. Wow! rogue(6) spices things up even more with maybe two bends in the passage. The problem here is that passages always having one bend is perhaps too predictable and players will more quickly tire of seeing the same old, same old. Depending on the field-of-view code there may be tactical considerations at each bend (listen? throw a grenade?) though of course having to listen or throw a grenade at each and every damn bend for optimal play might be bad. Too tedious, too grindy. On the other hand, more twisty passages could be much appreciated when there are Orc Archers trying to Boromir you, or plasma rifle fire to evade. Scifi verses fantasy is mostly flavor.

Given the list (technically, an array reference) of points, one elaboration might be to pass back the delta-x, delta-y, and other metadata so the caller can complicate the passage by maybe repeating the half-rectangle trick on a subset of the line: draw from the start and end points along the path for some subset, then repeat the half-rectangle call from where the incomplete paths stopped.