The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package UAV::Pilot::SDL::Window;
use v5.14;
use Moose;
use namespace::autoclean;
use SDL;
use SDL::Video qw{ :surface :video };
use SDLx::App;
use UAV::Pilot::SDL::WindowEventHandler;

with 'UAV::Pilot::EventHandler';
with 'UAV::Pilot::Logger';

use constant {
    SDL_TITLE  => 'UAV::Pilot',
    SDL_WIDTH  => 0,
    SDL_HEIGHT => 0,
    SDL_DEPTH  => 32,
    SDL_FLAGS  => SDL_HWSURFACE | SDL_HWACCEL | SDL_ANYFORMAT,
    BG_COLOR   => [ 0,   0,   0   ],
    DIAG_COLOR => [ 255, 255, 0   ],

    TOP    => 0,
    BOTTOM => 1,
    #LEFT   => 2,
    #RIGHT  => 3,
};


has 'sdl' => (
    is  => 'ro',
    isa => 'SDLx::App',
);
has 'children' => (
    traits  => ['Array'],
    is      => 'ro',
    isa     => 'ArrayRef[HashRef[Item]]',
    default => sub {[]},
    handles => {
        '_add_child'       => 'push',
        '_has_no_children' => 'is_empty',
    },
);
has 'yuv_overlay' => (
    is     => 'ro',
    isa    => 'Maybe[SDL::Overlay]',
    writer => '_set_yuv_overlay',
);
has 'yuv_overlay_rect' => (
    is     => 'ro',
    isa    => 'Maybe[SDL::Rect]',
    writer => '_set_yuv_overlay_rect',
);
has 'width' => (
    is      => 'ro',
    isa     => 'Int',
    default => 0,
    writer  => '_set_width',
);
has 'height' => (
    is      => 'ro',
    isa     => 'Int',
    default => 0,
    writer  => '_set_height',
);
has '_origin_x' => (
    is  => 'rw',
    isa => 'Int',
);
has '_origin_y' => (
    is  => 'rw',
    isa => 'Int',
);
has '_drawer' => (
    is  => 'rw',
    isa => 'Maybe[UAV::Pilot::SDL::WindowEventHandler]',
);
has '_bg_color' => (
    is  => 'ro',
);
has '_diag_color' => (
    is  => 'ro',
);
has '_bg_rect' => (
    is  => 'rw',
    isa => 'SDL::Rect',
);


sub BUILDARGS
{
    my ($class, $args) = @_;
    my @bg_color_parts = @{ $class->BG_COLOR };
    my $sdl = SDLx::App->new(
        title      => $class->SDL_TITLE,
        width      => $class->SDL_WIDTH,
        height     => $class->SDL_HEIGHT,
        depth      => $class->SDL_DEPTH,
        flags      => $class->SDL_FLAGS,
        resizeable => 1,
    );

    my $bg_color = SDL::Video::map_RGB( $sdl->format, @bg_color_parts );
    my $bg_rect = SDL::Rect->new( 0, 0, $class->SDL_WIDTH, $class->SDL_HEIGHT );
    my $diag_color = SDL::Video::map_RGB( $sdl->format, @{$class->DIAG_COLOR});

    $$args{sdl}         = $sdl;
    $$args{width}       = $class->SDL_WIDTH;
    $$args{height}      = $class->SDL_HEIGHT;
    $$args{_bg_color}   = $bg_color;
    $$args{_diag_color} = $diag_color;
    $$args{_bg_rect}    = $bg_rect;
    return $args;
}


sub add_child
{
    my ($self, $child, $float) = @_;
    $float //= $self->TOP;

    my ($x, $y, $new_width, $new_height) = $self->_calc_new_child(
        $child, $float );

    $self->_resize( $new_width, $new_height );
    $self->_add_child({
        origin_x => $x,
        origin_y => $y,
        drawer   => $child,
    });

    return 1;
}

sub add_child_with_yuv_overlay
{
    my ($self, $child, $overlay_flag, $float) = @_;
    $float //= $self->TOP;

    my $width  = $child->width;
    my $height = $child->height;
    my ($x, $y, $new_width, $new_height) = $self->_calc_new_child(
        $child, $float );

    my $sdl = $self->sdl;
    my $overlay = SDL::Overlay->new( $width, $height, $overlay_flag, $sdl );
    my $overlay_rect = SDL::Rect->new( $x, $y, $width, $height );

    $self->_set_yuv_overlay( $overlay );
    $self->_set_yuv_overlay_rect( $overlay_rect );

    $self->_resize( $new_width, $new_height );
    $self->_add_child({
        origin_x => $x,
        origin_y => $y,
        drawer   => $child,
    });
    return 1;
}



sub process_events
{
    my ($self) = @_;
    my $logger = $self->_logger;
    $logger->info( 'Start drawing of SDL window' );

    foreach my $child (@{ $self->children }) {
        my $drawer = $child->{drawer};
        $logger->debug( 'Drawing child ' . ref($drawer) );
        $self->_origin_x( $child->{origin_x} );
        $self->_origin_y( $child->{origin_y} );
        $self->_drawer( $drawer );
        $drawer->draw( $self );
    }

    my $rect = $self->_bg_rect;
    $logger->debug( 'Updating rect'
        . '. X: '     . $rect->x
        . ' Y: '      . $rect->y
        . ' Width: '  . $rect->w
        . ' Height: ' . $rect->h );
    SDL::Video::update_rects( $self->sdl, $self->_bg_rect );
    # Cleanup
    $self->_origin_x( 0 );
    $self->_origin_y( 0 );
    $self->_drawer( undef );

    $logger->info( 'Done drawing to SDL window' );
    return 1;
}

sub clear_screen
{
    my ($self) = @_;
    $self->_logger->debug( 'Clearing screen' );
    my $drawer = $self->_drawer;
    my $bg_rect = SDL::Rect->new( $self->_origin_x, $self->_origin_y,
        $drawer->width, $drawer->height );
    SDL::Video::fill_rect(
        $self->sdl,
        $bg_rect,
        $self->_bg_color,
    );
    return 1;
}

sub draw_txt
{
    my ($self, $text, $x, $y, $sdl_text) = @_;
    $x += $self->_origin_x;
    $y += $self->_origin_y;
    $sdl_text->write_xy( $self->sdl, $x, $y, $text );
    return 1;
}

sub draw_line
{
    my ($self, $left_coords, $right_coords, $color) = @_;
    $left_coords->[0]  += $self->_origin_x;
    $left_coords->[1]  += $self->_origin_y;
    $right_coords->[0] += $self->_origin_x;
    $right_coords->[1] += $self->_origin_y;

    $self->sdl->draw_line( $left_coords, $right_coords, $color );
    return 1;
}

sub draw_circle
{
    my ($self, $center_coords, $radius, $color ) = @_;
    $center_coords->[0] += $self->_origin_x;
    $center_coords->[1] += $self->_origin_y;
    $self->sdl->draw_circle( $center_coords, $radius, $color );
    return 1;
}

sub draw_rect
{
    my ($self, $rect_data, $color) = @_;
    $rect_data->[0] += $self->_origin_x;
    $rect_data->[1] += $self->_origin_y;
    $self->sdl->draw_rect( $rect_data, $color);
    return 1;
}


sub _resize
{
    my ($self, $width, $height) = @_;
    my $bg_rect = SDL::Rect->new( 0, 0, $width, $height );

    $self->sdl->resize( $width, $height );
    $self->_set_width( $width );
    $self->_set_height( $height );
    $self->_bg_rect( $bg_rect );
    return 1;
}

sub _calc_new_child
{
    my ($self, $child, $float) = @_;
    my $x = 0;
    my $y = 0;
    my $new_width = 0;
    my $new_height = 0;

    if( $self->_has_no_children ) {
        $new_width  = $child->width;
        $new_height = $child->height;
    }
    elsif( $self->BOTTOM == $float ) {
        ($new_width, $new_height) = $self->_calc_resize_vert( $child );
        ($x, $y) = $self->_calc_position_bottom( $child );
    }
    else {
        # Assume TOP
        ($new_width, $new_height) = $self->_calc_resize_vert( $child );
    }

    return ($x, $y, $new_width, $new_height);
}

sub _calc_resize_vert
{
    my ($self, $child) = @_;
    my $child_height = $child->height;
    my $child_width  = $child->width;
    my $new_width  = $child_width;
    my $new_height = $child_height + $self->height;

    foreach my $child (@{ $self->children }) {
        my $width = $child->{drawer}->width;
        $new_width = $width
            if $width > $new_width;
    }

    return ($new_width, $new_height);
}

sub _calc_position_bottom
{
    my ($self, $child) = @_;
    my $x = 0;
    my $y = 0;
    $y += $_->{drawer}->height for @{ $self->children };
    return ($x, $y);
}


no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__

=head1 NAME

  UAV::Pilot::SDL::Window

=head1 SYNOPSIS

    my $window = UAV::Pilot::SDL::Window->new;
    $window->add_child( $window_event_handler );

    # In the child's draw method
    $window->clear_screen;
    $window->draw_line( [0, 0], [128, 128], $color );
    $window->draw_circle( [ 512, 512 ], 10, $color );

=head1 DESCRIPTION

A basic windowing system for drawing widgets.  Currently only supports adding 
new widgets on top or below an existing widget.

Does the C<UAV::Pilot::EventHandler> role.

=head1 METHODS

=head2 add_child

    add_child( $handler, $float ).

Pass a child that does the C<UAV::Pilot::SDL::WindowEventHandler> role.  
Float should be C<<$window->TOP>> or C<<$window->BOTTOM>> for the location to 
draw this child.  The window will be expanded to fit the child's width/height.

=head2 add_child_with_yuv_overlay

    add_child_with_yuv_overlay( $handle, $overlay_flag, $float )

Pass a child that does the C<UAV::Pilot::SDL::WindowEventHandler> role.  The 
C<$overlay_flag> will be the flag passed to C<SDL::Overlay> (see that module's 
docs for details).  The C<$float> param is the same as C<add_child()>.

=head2 sdl

Returns the C<SDLx::App> object for the given SDL window.

=head2 yuv_overlay

If a child was added with C<add_child_with_yuv_overlay()>, returns the 
C<SDL::Overlay> object.

=head2 yuv_overlay_rect

If a child was added with C<add_child_with_yuv_overlay()>, returns an 
C<SDL::Rect> object that covers the overlay area.

=head1 DRAWING METHODS

The should only be used by widgets when their C<draw()> method is called.

All C<$x, $y> coordinates are relative to the widgets's drawing area.

=head2 clear_screen

Blanks the area that the current widget is being drawn in.

=head2 draw_txt

    draw_txt( $string, $x, $y, $sdl_text )

Draws text to the screen.  Params:

C<$string>: The string to write

C<$x, $y>: The coords to draw at

C<$sdl_text>: An C<SDLx::Text> object

=head2 draw_line

    draw_line( [$x0,$y0], [$x1,$y1], $color )

Draws a line.  The C<$color> param is an C<SDL::Color> object.

=head2 draw_circle

    draw_circle( [$x,$y], $radius, $color )

Draws a circle.  The C<$color> param is an C<SDL::Color> object.

=head2 draw_rect

    draw_rect( [$x, $y, $width, $height], $color )

Draws a rect.  the C<$color> param is an C<SDL::Color> object.

=cut