Front page | perl.sdl.devel |
Postings from December 2011
AW: Button-Binding
Thread Previous
From:
Alex
Date:
December 18, 2011 14:13
Subject:
AW: Button-Binding
Message ID:
000801ccbdd2$34de0890$9e9a19b0$@gmx.de
#!perl
package My::Button;
use strict;
use warnings;
use SDL;
use SDLx::Rect;
use SDLx::Text;
use Data::Dumper qw/Dumper/;
=head1 My::Button
A simple button with text.
=head1 METHODS
=cut
sub new {
my ($class, %params) = @_;
my $self = {};
bless($self, $class);
for( qw/-app -x -y -command -text -width -height -activebackground -background/ ) {
$self->{$_} = delete $params{$_};
}
$self->_init();
return $self;
} # /new
=head2 _init()
Private method.
=cut
sub _init {
my $self = shift;
my $text = SDLx::Text->new(
color => [255, 255, 255], # "white"
size => 24,
x => 0,
y => 0,
h_align => 'center',
shadow => 1,
bold => 1,
text => $self->{'-text'},
);
#$text->x( $self->{'-x'} + int($text->w / 2) + 5 );
$text->x( $self->{'-x'} + int($self->{'-width'} / 2) );
$text->y( $self->{'-y'} + int($text->h / 2) );
$self->{'text'} = $text;
return;
} # /_init
=head2 draw()
=cut
sub draw{
my $self = shift;
my $box = SDLx::Rect->new(
$self->{'-x'},
$self->{'-y'},
$self->{'-width'},
$self->{'-height'}
);
$self->{'-app'}->draw_rect( $box, $self->{'-background'} );
$self->{text}->write_to( $self->{'-app'} );
$self->{'-app'}->update();
$self->{'state'} = 'normal';
return;
} # /draw
=head2 hover()
=cut
sub hover{
my $self = shift;
my $box = SDLx::Rect->new(
$self->{'-x'},
$self->{'-y'},
$self->{'-width'},
$self->{'-height'}
);
$self->{'-app'}->draw_rect( $box, $self->{'-activebackground'} );
$self->{text}->write_to( $self->{'-app'} );
$self->{'-app'}->update();
$self->{'state'} = 'hover';
return;
} # /hover
=head2 check_hover()
=cut
sub check_hover{
my ($self, $mx, $my, $event) = @_;
#Hover - Effekt
if( $mx > $self->{'-x'} &&
$mx < ($self->{'-x'}+ $self->{'-width'}) &&
$my > $self->{'-y'} &&
$my < ($self->{'-y'}+ $self->{'-height'}) ){
$self->hover() if $self->{'state'} ne 'hover';
} else {
$self->draw();
}
return;
} # /check_hover
=head2 check_click()
=cut
sub check_click {
my ($self, $mx, $my, $event) = @_;
#Hover - Effekt
if( $mx > $self->{'-x'} &&
$mx < ($self->{'-x'}+ $self->{'-width'}) &&
$my > $self->{'-y'} &&
$my < ($self->{'-y'}+ $self->{'-height'}) ){
$self->{'-command'}->();
}
return;
} # /check_click
=head1 CREDITS
c.f. L<http://www.perl-community.de/bat/poard/thread/7847>
=cut
1; # /My::Button
use SDL;
use SDLx::App;
use SDL::Event;
use SDL::Events;
use SDLx::Surface;
use SDL::Color;
my $app = SDLx::App->new(
w => 640,
h => 400,
exit_on_quit => 1,
);
my $btn = My::Button->new(
-app => $app,
-x => 50,
-y => 50,
-width => 240,
-height => 60,
-text => 'Buttontext',
-command => sub{ print "hi"; return 1; },
-background => 0xA7A6BD5A,
-activebackground => 0x8F8BC65A,
);
$btn->draw();
$app->add_event_handler(\&quit_event);
$app->add_event_handler(\&menu_hover_event);
$app->add_event_handler(\&menu_click_event);
$app->run();
sub quit_event {
my ($event, $app) = @_;
if($event->type == SDL_QUIT) {
$app->stop;
}
} # /quit_event
sub menu_hover_event {
my ($event, $app) = @_;
if($event->type == SDL_MOUSEMOTION) {
$btn->check_hover($event->motion_x, $event->motion_y, $event);
}
} # /menu_hover_event
sub menu_click_event {
my ($event, $app) = @_;
if($event->type == SDL_MOUSEBUTTONUP) {
$btn->check_click($event->motion_x, $event->motion_y, $event);
}
} # /menu_click_event
exit(0);
Thread Previous