# # This file is part of Curses-Toolkit # # This software is copyright (c) 2011 by Damien "dams" Krotkine. # # This is free software; you can redistribute it and/or modify it under # the same terms as the Perl 5 programming language system itself. # use warnings; use strict; package Curses::Toolkit::Widget::Border; { $Curses::Toolkit::Widget::Border::VERSION = '0.210'; } # ABSTRACT: a border widget use parent qw(Curses::Toolkit::Widget::Bin); use Params::Validate qw(SCALAR ARRAYREF HASHREF CODEREF GLOB GLOBREF SCALARREF HANDLE BOOLEAN UNDEF validate validate_pos); use Curses::Toolkit::Object::Coordinates; our @EXPORT_OK = qw(Border); our %EXPORT_TAGS = (all => [qw(Border)]); sub Border { 'Curses::Toolkit::Widget::Border' } sub draw { my ($self) = @_; my $theme = $self->get_theme(); my $c = $self->get_coordinates(); my $border_width = $self->get_theme_property('border_width'); $border_width > 0 or return; for my $i ( 0 .. $border_width - 1 ) { $theme->draw_hline( $c->get_x1() + $i, $c->get_y1() + $i, $c->width() - 2 * $i ); $theme->draw_hline( $c->get_x1() + $i, $c->get_y2() - $i - 1, $c->width() - 2 * $i ); $theme->draw_vline( $c->get_x1() + $i, $c->get_y1() + $i, $c->height() - 2 * $i ); $theme->draw_vline( $c->get_x2() - $i - 1, $c->get_y1() + $i, $c->height() - 2 * $i ); $theme->draw_corner_ul( $c->get_x1() + $i, $c->get_y1() + $i ); $theme->draw_corner_ll( $c->get_x1() + $i, $c->get_y2() - $i - 1 ); $theme->draw_corner_ur( $c->get_x2() - $i - 1, $c->get_y1() + $i ); $theme->draw_corner_lr( $c->get_x2() - $i - 1, $c->get_y2() - $i - 1 ); } return; } # Returns the relative rectangle that a child widget can occupy. # This returns the current widget space, shrinked by the border size # # input : none # output : a Curses::Toolkit::Object::Coordinates object sub _get_available_space { my ($self) = @_; my $rc = $self->get_relatives_coordinates(); my $bw = $self->get_theme_property('border_width'); return Curses::Toolkit::Object::Coordinates->new( x1 => $bw, y1 => $bw, x2 => $rc->width() - $bw, y2 => $rc->height() - $bw, # x2 => $rc->get_x2() - $bw, y2 => $rc->get_y2() - $bw, ); } sub get_desired_space { my ( $self, $available_space ) = @_; defined $available_space or return $self->get_minimum_space(); my ($child) = $self->get_children(); my $child_space = Curses::Toolkit::Object::Coordinates->new_zero(); my $bw = $self->get_theme_property('border_width'); if ( defined $child ) { # computation goes like that : # desired space = child_desired_space(available_space - borders) + borders my $child_available_space = $available_space->clone(); $child_available_space->set( x1 => $available_space->get_x1() + $bw, y1 => $available_space->get_y1() + $bw, x2 => $available_space->get_x2() - $bw, y2 => $available_space->get_y2() - $bw, ); $child_space = $child->get_desired_space($child_available_space); my $desired_space = $available_space->clone(); $desired_space->set( x2 => $desired_space->get_x1() + $child_space->width() + 2 * $bw, y2 => $desired_space->get_y1() + $child_space->height() + 2 * $bw, ); return $desired_space; } my $desired_space = $available_space->clone(); return $desired_space; } sub get_minimum_space { my ( $self, $available_space ) = @_; my ($child) = $self->get_children(); my $bw = $self->get_theme_property('border_width'); if ( ! defined $available_space) { defined $child or return Curses::Toolkit::Object::Coordinates->new( x1 => 0 , y1 => 0, x2 => 2*$bw, y2 => 2*$bw, ); my $minimum_space = $child->get_minimum_space(); $minimum_space->set( x2 => $minimum_space->get_x2() + 2*$bw, y2 => $minimum_space->get_y2() + 2*$bw, ); return $minimum_space; } my $child_space = Curses::Toolkit::Object::Coordinates->new_zero(); # computation goes like that : # minimum space = (child_minimum_space(available_space - borders) + borders) if ( defined $child ) { my $child_available_space = $available_space->clone(); $child_available_space->set( x1 => $available_space->get_x1() + $bw, y1 => $available_space->get_y1() + $bw, x2 => $available_space->get_x2() - $bw, y2 => $available_space->get_y2() - $bw, ); $child_space = $child->get_minimum_space($child_available_space); } my $minimum_space = $available_space->clone(); $minimum_space->set( x2 => $available_space->get_x1() + $child_space->width() + 2 * $bw, y2 => $available_space->get_y1() + $child_space->height() + 2 * $bw, ); return $minimum_space; } sub _get_theme_properties_definition { my ($self) = @_; return { %{ $self->SUPER::_get_theme_properties_definition() }, border_width => { optional => 1, type => SCALAR, callbacks => { "positive integer" => sub { $_[0] >= 0 } } }, }; } sub get_visible_shape_for_children { my ($self) = @_; my $shape = $self->get_visible_shape(); my $bw = $self->get_theme_property('border_width'); $shape->width >= 2 * $bw and $shape->set( x1 => $shape->get_x1() + $bw, x2 => $shape->get_x2() - $bw); $shape->height >= 2 * $bw and $shape->set( y1 => $shape->get_y1() + $bw, y2 => $shape->get_y2() - $bw); return $shape; } 1; __END__ =pod =head1 NAME Curses::Toolkit::Widget::Border - a border widget =head1 VERSION version 0.210 =head1 SYNOPSIS my $border = Curses::Toolkit::Widget::Border->new; $border->add_widget($some_other_widget); =head1 DESCRIPTION This widget consists of a border, and a child widget in that border This widget can contain 0 or 1 other widget. =head1 Appearence +----------+ | | +----------+ =head1 CONSTRUCTOR =head2 new input : none output : a Curses::Toolkit::Widget::Border =head2 get_desired_space Given a coordinate representing the available space, returns the space desired The Border desires as much as its children desires, plus its width input : a Curses::Toolkit::Object::Coordinates object output : a Curses::Toolkit::Object::Coordinates object =head2 get_minimum_space Given a coordinate representing the available space, returns the minimum space needed to properly display itself input : a Curses::Toolkit::Object::Coordinates object output : a Curses::Toolkit::Object::Coordinates object =head1 Theme related properties To set/get a theme properties, you should do : $border->set_theme_property(property_name => $property_value); $value = $border->get_theme_property('property_name'); Here is the list of properties related to the border, that can be changed in the associated theme. See the Curses::Toolkit::Theme class used for the default (default class to look at is Curses::Toolkit::Theme::Default) Don't forget to look at properties from the parent class, as these are also inherited from ! =head2 border_width Sets the width of the border. If not set, the border will be invisible =head1 AUTHOR Damien "dams" Krotkine =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2011 by Damien "dams" Krotkine. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut