#!/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;
}