develooper 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


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About