AW: Button-Binding

[email protected] ("Alex") Sun, 18 Dec 2011 23:13:00 +0100
Newsgroups perl.sdl.devel
Message-ID <[email protected]>
Hi!

 

Then I think I will stick to SDLx::App, because it seems easier for me to
add and remove event handlers depending on the applications state. Please
find below & attached the 2 experiments for the button, in case someone
finds it interesting or has an idea for optimization. 

 

Thx & regards,

Alex

 

[code]

#!perl

# this is my button4.pl

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);

[/code]

 

 

Von: Tobias Leich [mailto:[email protected]] 
Gesendet: Sonntag, 18. Dezember 2011 22:56
An: Alex
Cc: [email protected]
Betreff: Re: Button-Binding

 

Hi, if you use SDLx::App and its ->run method you can use the event
handlers. SDLx::App is basically a huge while loop that loops over its
registered handlers.

If you are not using SDLx::App, you have to do it yourself in a while loop.

Thats it.

--
Cheers, FROGGS

PS: please forget about my office mail address.

 


Am 18.12.2011 21:34, schrieb Alex: 

Hm, when do I use a selfmade while loop that processes the event queue and
when do I use add_event_handler() from SDLx for processing events?

Kind regards,
Alex

-----Ursprüngliche Nachricht-----
Von: Leich Tobias [mailto:[email protected]]
Gesendet: Mittwoch, 14. Dezember 2011 10:27
An: Alex
Cc: [email protected]
Betreff: Re: Button-Binding

Hi, for b)

Add an event listener like this http://sdl.perl.org/SDL-Events.html#SYNOPSIS
and call the tk-callback when receiving the right event. (SDL_MOUSEBUTTONUP
I suppose)

Cheers, FROGGS

mit freundlichen Grüßen

Tobias Leich
Entwicklung ICT

telent GmbH - ein Unternehmen der euromicron Gruppe Rheinstraße 10B, D-14513
Teltow

Tel.:   +49-(0)3328 4590-512
Fax.:   +49-(0)3328 4590-55 512
Mobil:  +49-(0)152 579 39 064
E-Mail: [email protected]<mailto:[email protected]>
Internet:       www.telent.de<http://www.telent.de>

telent GmbH - ein Unternehmen der euomicron Gruppe, Sitz Backnang;
Registergericht: Amtsgericht Stuttgart, HRB 738199
Geschäftsführung: Dr. Stefan Kindt, Hans-Peter Fischer, Robert Blum,
Alexander Thome

Am 09.12.2011 22:00, schrieb Alex:

Deal all!

I continue my experiments with SDL. I found some old thread somewhere and
now I have a button-like image that switches its appearance when I hover
over it (with the mouse).

Here are the questions:
a) Is the code attached the recommended way to do it or should it be done in
another fashion?
b) I would like to add an action, when someone clicks the button. In
Tk-terminology, this would be a callback. Any suggestions on how I should do
this?

Best regards,
Alex

[code]
#!perl

package My::SimpleButton;

use strict;
use warnings;
use SDL;
use SDLx::Rect;
use Data::Dumper qw/Dumper/;

=head1

=cut

sub new {
    my ($class,@params) = @_;
    my $self = {};
    bless($self,$class);
    for(qw(ID APP X Y IMG IMGHV IMGPRESSED)){
        $self->{$_} = shift(@params);
    }
    $self->{HV} = 0;

    $self->draw($self->{IMG});

    return($self);
}



sub draw{
    my ($self, $img) = @_;

    my $frame_rect = SDLx::Rect->new(0, 0, $img->width(), $img->height());
    my $dest_rect = SDLx::Rect->new(
        $self->{X},
        $self->{Y},
        $img->width(),
        $img->height(),
    );

    $self->{APP}->blit_by($img, [0, 0, $img->width(), $img->height()], [
        $self->{X},
        $self->{Y},
        $img->width(),
        $img->height(),
    ]);
    $self->{APP}->update();

    return 1;
}

sub check{
    my ($self,$mx,$my,$event) = @_;

    my $img = $self->{IMG};

    #Hover - Effekt
    if( $mx > $self->{X} &&
        $mx < ($self->{X}+ $img->width)  &&
        $my > $self->{Y}    &&
        $my < ($self->{Y}+ $img->height) ){

        if( !$self->{HV} ) {
            $self->{HV} = 1;
            $self->draw($self->{IMGHV});
        }

    } else {
        if($self->{HV}) {
            $self->{HV}=0;
            $self->draw($self->{IMG});
        }
        return 0;

    }

    return;
}

=head1 CREDITS

c.f.
L<http://www.perl-community.de/bat/poard/thread/7847><http://www.perl-commun
ity.de/bat/poard/thread/7847>

=cut

1; # /My::SimpleButton

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,
);
$app->add_event_handler( \&quit_event ); $app->add_event_handler(
\&mnouseover );

my $img = SDLx::Surface->load( 'images/blueOpera_1.png' ); my $img2 =
SDLx::Surface->load( 'images/blueOpera_2.png' ); my $img3 =
SDLx::Surface->load( 'images/redOpera_2.png' );

my $SimpleButton = My::SimpleButton->new(1, $app, 65, 25, $img, $img2,
$img3);

$app->run();

sub quit_event {
    #The callback is provided a SDL::Event to use
    my $event = shift;

    #Each event handler also returns you back the Controller call it
    my $controller = shift;

    #Stopping the controller for us will exit $app->run() for us
    $controller->stop if $event->type == SDL_QUIT; } # /quit_event


sub mnouseover {
    #The callback is provided a SDL::Event to use
    my $event = shift;

    #Each event handler also returns you back the Controller call it
    my $controller = shift;

    if( $event->type == SDL_MOUSEMOTION ) {
        my $click = $SimpleButton->check($event->motion_x,
$event->motion_y,$event);
    }
} # /mnouseover


exit(0);
[/code]





Scanned by MailDefender - managed email security from intY -
www.maildefender.net
-----
eMail ist virenfrei.
Von AVG überprüft - www.avg.de
Version: 10.0.1415 / Virendatenbank: 2108/4084 - Ausgabedatum: 16.12.2011


Scanned by MailDefender - managed email security from intY -
www.maildefender.net

  _____  

eMail ist virenfrei.
Von AVG überprüft - www.avg.de
Version: 10.0.1415 / Virendatenbank: 2108/4088 - Ausgabedatum: 18.12.2011
button4.pl.txt (text/plain, 3.8 KB)
#!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);
button3.pl.txt (text/plain, 3.7 KB)
#!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();

my $event = SDL::Event->new(); # notices 'Event' ne 'Events'

my $quit = 0;
while( !$quit ) {
    SDL::Events::pump_events();
    while(  SDL::Events::poll_event($event) ) {
        if( $event->type == SDL_QUIT ) {
            $quit = 1;
        }elsif( $event->type == SDL_MOUSEMOTION ) {
            $btn->check_hover($event->motion_x, $event->motion_y, $event);
        }elsif( $event->type == SDL_MOUSEBUTTONUP ) {
            $btn->check_click($event->motion_x, $event->motion_y, $event);
        }
    }
    $app->update();
}

exit(0);