App-GUI-Cellgraph
view release on metacpan or search on metacpan
lib/App/GUI/Cellgraph/Frame/Panel/Board.pm view on Meta::CPAN
# painting area on left side
package App::GUI::Cellgraph::Frame::Panel::Board;
use base qw/Wx::Panel/;
use v5.12;
use warnings;
use Wx;
#use Benchmark;
use App::GUI::Cellgraph::Compute::Grid;
use Graphics::Toolkit::Color qw/color/;
sub new {
my ( $class, $parent, $size ) = @_;
my $self = $class->SUPER::new( $parent, -1, [-1,-1], [$size, $size] );
$self->{'img_size'} = $size;
$self->{'menu_size'} = 27;
$self->{'size'}{'x'} = $size;
$self->{'size'}{'y'} = $size;
$self->{'dc'} = Wx::MemoryDC->new( );
$self->{'bmp'} = Wx::Bitmap->new( $self->{'size'}{'x'} + 10, $self->{'size'}{'y'} +10 + $self->{'menu_size'}, 24);
$self->{'dc'}->SelectObject( $self->{'bmp'} );
Wx::Event::EVT_PAINT( $self, sub {
my( $self, $event ) = @_;
return unless ref $self->{'state'};
$self->{'x_pos'} = $self->GetPosition->x;
$self->{'y_pos'} = $self->GetPosition->y;
if (exists $self->{'flag'}{'state_changed'}) {
$self->{'dc'}->Blit (0, 0, $self->{'size'}{'x'} + $self->{'x_pos'},
$self->{'size'}{'y'} + $self->{'y_pos'} + $self->{'menu_size'},
$self->paint( Wx::PaintDC->new( $self ), $self->{'size'}{'x'}, $self->{'size'}{'y'} ), 0, 0);
} else {
Wx::PaintDC->new( $self )->Blit (0, 0, $self->{'size'}{'x'},
$self->{'size'}{'y'} + $self->{'menu_size'},
$self->{'dc'},
$self->{'x_pos'} , $self->{'y_pos'} + $self->{'menu_size'} );
}
1;
});
return $self;
}
sub draw {
my( $self, $state ) = @_;
delete $self->{'flag'}; # ugly workaround
return unless $self->set_state( $state );
$self->{'flag'}{'draw'} = 1;
$self->Refresh;
}
sub sketch {
my( $self, $state ) = @_;
delete $self->{'flag'}; # ugly workaround
return unless $self->set_state( $state );
$self->{'flag'}{'sketch'} = 5;
$self->Refresh;
}
sub set_state {
my( $self, $state ) = @_;
return 0 unless ref $state eq 'HASH';
$self->{'state'} = $state;
$self->{'flag'}{'state_changed'} = 1;
}
sub set_size {
my( $self, $size ) = @_;
return unless defined $size;
$self->{'img_size'} = $size;
}
sub paint {
my( $self, $dc, $width, $height ) = @_;
( run in 0.908 second using v1.01-cache-2.11-cpan-75ffa21a3d4 )