Schrift
Wiki:Tipp zum Debugging: use Data::Dumper; local $Data::Dumper::Useqq = 1; print Dumper \@var;
Start · Board · Anwendungen/Programme/Skripte in Perl · Allgemeines zu Perl
[thread]7847[/thread]

OO-Button-Modul: für SDL (ab geht um OO)

Leser: 1


<< |< 1 2 3 4 >| >> 38 Einträge, 4 Seiten
master
 2006-03-31 19:08
#64249 #64249
User since
2003-10-20
610 Artikel
BenutzerIn
[default_avatar]
SimpleButton.pm

Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
#!/usr/bin/perl

package SimpleButton;

sub new {
 my $self = shift;
 my $Referenz = {};
 bless($Referenz,$self);
 return($Referenz);
}



sub add_Butt
{
    my $self = shift;
    $self->{ID} = shift;
    $self->{APP} = shift;
    $self->{X} = shift;
    $self->{Y} = shift;
    $self->{IMG} = shift;
    $self->{IMGHV} = shift;
    $self->{HV} = 0;


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







sub draw
{
      my $self = shift;
    my $img = shift;

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


    $img->blit( $frame_rect, $self->{APP}, $dest_rect );
    $self->{APP}->update( $dest_rect );
    $self->{APP}->flip;
    return 1;
}







sub check
{
    my $self = shift;
    my $mx = shift;
    my $my = shift;
    my $event = shift;

    my $img = $self->{IMG};
    
    #Hover - Effekt
    if($mx > $self->{X} &&  $mx < ($self->{X}+ $img->width)  && $my > $self->{Y}    &&   $my < ($self->{Y}+ $img->height) )
    {
          if(not  $self->{HV}) {$self->{HV}=1; $self->draw($self->{IMGHV});}
        if($event->button eq 1 )  {return $self->{ID};}
    } else
    {
        if($self->{HV}) {$self->{HV}=0; $self->draw($self->{IMG});}
        return 0;
    }

}






1;



Aufruf:
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
use FindBin qw($Bin); chdir($Bin);

use lib $FindBin::Bin . '/LIBS';
use SimpleButton; #in zusätzlichen sub dir "X", daher X::

my $SimpleButton = SimpleButton->new();




use SDL;
use SDL::App;
use SDL::Event;
use SDL::Surface;
use SDL::Color;
use SDL::Rect;

my $app = SDL::App->new(
        -width  => 900,
        -height => 600,
        -depth  => 16,
);




my $img = SDL::Surface->new( -name => 'x.png' );
my $img2 = SDL::Surface->new( -name => 'x_on.png' );


for my $i (0..10)
{
    for my $x (0..7)
    {
        $SimpleButton = SimpleButton->new();
        $id++;
        $SimpleButton->add_Butt($id,$app,(105*$x),(45*$i),$img,$img2);

        push(@butts,$SimpleButton);
    }
    
}






$event = new SDL::Event();


while(1)
{
  # process event queue
    $event->pump;
    $event->poll;
    my $etype=$event->type;

    # handle user events
    last if ($etype eq SDL_QUIT );
    last if (SDL::GetKeyState(SDLK_ESCAPE));

    for(@butts)
    {
            my $click = $_->check($event->button_x,$event->button_y,$event);
            if($click ne 0 )            {print "\r  ",$click,"      ";}

    }


}




Nun brauche ich Verbessrungs- und Optimierungsvorschläge? :-)

Wenn alles gut geht kommt das modul dann mal auf CPAN.
$i='re5tsFam ^l\rep';$i=~s/[^a-z| ]//g;$\= reverse "\U!$i";print;
ptk
 2006-04-01 01:44
#64250 #64250
User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]
Aber bitte mit vernünftigen Modulnamen!
ptk
 2006-04-01 02:01
#64251 #64251
User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]
Die Sequenz SimpleButton->new und dann $simplebutton->add_Butt gefällt mir nicht. Wie sind die Namingkonventionen bei SDL? Eine Mischung aus Javastyle (gemischte Klein/Großschreibung) und Perlstyle (mit Unterstrichen) erscheint mir nicht richtig. Ich würde es auch lieber so machen: bereits in new() alle Konfigurationsparameter setzen und statt add_Butt() gleich draw() aufrufen lassen. Vielleicht auf $id als Argument verzichten und stattdessen einen Callback definieren (wie -command bei Perl/Tk?)?

Cooler wäre es noch (aber dann nicht mehr "Simple"), wenn du noch ein Objekt hättest, dass als Container für alle Widget-Objekte fungiert. SimpleButton wäre dann nur eins dieser Widget-Objekte, und du könntest auch noch Radiobuttons, Checkbuttons etc. implementieren. Der Vorteil wäre dann, dass man die checkloop als Benutzer des Moduls nicht selbst implementieren muss, sondern der Container diese Aufgabe übernehmen könnte.
master
 2006-04-01 10:48
#64252 #64252
User since
2003-10-20
610 Artikel
BenutzerIn
[default_avatar]
@ptk

Danke für den Tip :-)

Alles in new zu machen habe ich auch vor..
Du musst wissen, es ist mein erstes eigenes Modul und in perl/OOP :-)

Die checkloop zu integrieren wäre cool. nur weiss ich noch nicht recht wie, zumal es sich ja in den SDL-Event integrieren
muss...

Ich meine wie kann ich denn im Modul alle Buttons durchlaufen?

Naja immerhin ist der Anfang schon gemacht. Ein vernünftiges Buttonsystem fehlt nämlich in Perl_SDL (es gibt zwar einen, aber der ist nur GPL und kann nicht alles...)

Ich vereinfache es nochmal einwenig :-)


ps. Was meinst du mit vernünftigen Modulnamen?

Das Ganze soll später als Perl_SDL::X::SimpleButton rein..
für X überlege ich mir nochwas.


"new + add_button" gefällt mir auch nicht:-)
$i='re5tsFam ^l\rep';$i=~s/[^a-z| ]//g;$\= reverse "\U!$i";print;
Matze
 2006-04-01 12:15
#64253 #64253
User since
2005-08-29
222 Artikel
BenutzerIn
[Homepage] [default_avatar]
Ich würde vielleicht nich die Möglichkeit geben nicht nur Bilder für den Button zu benutzen sondern, dass z.B. 2 Rechtecke aufeinander gezeichnet werden.

1 Rechteck: Der Rand.(Ein bisschen größer als Nummer 2)
2 Rechteck: Eigentlicher Button.

Dann müsstest du dir nur überlegen wie du die Größe der Schrift berechnest, die man auch noch drauf schreiben lassen können müsste.

MfG. Matze
Mit freundlichen Grüßen: Matze
ptk
 2006-04-01 16:10
#64254 #64254
User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]
In der SDL-Eventloop könntest du
Code: (dl )
$container->handle_events

reinschreiben. Der $container kennt alle seine Buttons (und anderen Widgets) und würde die Verarbeitung vornehmen. Wenn du mit Callbacks arbeitest, dann musst du auch nichts zurückgeben. Vielleicht nur einen boolschen Wert, ob der Event im Container verarbeitet wurde oder nicht.

Als Modulname: die anderen Module fangen mit SDL an und nicht mit Perl_SDL? Dann vielleicht SDL::X::Button, SDL::X::Checkbutton etc.
master
 2006-04-03 12:04
#64255 #64255
User since
2003-10-20
610 Artikel
BenutzerIn
[default_avatar]
Arg.. da klappt was nicht.. Wo liegt da mein Überlegungsfehler?

Quote
sub new {
my $self = shift;
my $Referenz = {};


$self->{ID} = shift;
$self->{APP} = shift;
$self->{X} = shift;
$self->{Y} = shift;
$self->{IMG} = shift;
$self->{IMGHV} = shift;
$self->{HV} = 0;


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

bless($Referenz,$self);
return($Referenz);
}
$i='re5tsFam ^l\rep';$i=~s/[^a-z| ]//g;$\= reverse "\U!$i";print;
renee
 2006-04-03 12:20
#64256 #64256
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
package SDL::X::SimpleButton;

sub new {
  my ($class,@params) = @_;
  my $self = {};
   bless($self,$class);

   for(qw(ID APP X IMG IMGHV)){
     $self->{$_} = shift(@params);
   }   
   $self->{HV} = 0;

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

  return($self);
}


sub draw{
     my ($self,$img) = @_;
  
   my $frame_rect = SDL::Rect->new(-height => $img->height(),-width  => $img->width(),-x      => 0, -y      => 0);
    my $dest_rect = SDL::Rect->new(-height => $img->height(),-width  => $img->width(),
   -x      => $self->{X},-y      => $self->{Y},);

   $img->blit( $frame_rect, $self->{APP}, $dest_rect );
   $self->{APP}->update( $dest_rect );
   $self->{APP}->flip;
    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(not  $self->{HV}) {
              $self->{HV}=1; 
              $self->draw($self->{IMGHV});
          }
          if($event->button == 1 )  {
               return $self->{ID};
           }
    } 
    else{
        if($self->{HV}) {
               $self->{HV}=0; 
               $self->draw($self->{IMG});
         }
        return 0;
    }

}

1;
\n\n

<!--EDIT|renee|1144052691-->
OTRS-Erweiterungen (http://feature-addons.de/)
Frankfurt Perlmongers (http://frankfurt.pm/)
--

Unterlagen OTRS-Workshop 2012: http://otrs.perl-services.de/workshop.html
Perl-Entwicklung: http://perl-services.de/
master
 2006-04-03 12:34
#64257 #64257
User since
2003-10-20
610 Artikel
BenutzerIn
[default_avatar]
Wieso dieser Aufbau?

Code: (dl )
1
2
3
4
  for(qw(ID APP X IMG IMGHV)){
    $self->{$_} = shift(@params);
  }   
  $self->{HV} = 0;
$i='re5tsFam ^l\rep';$i=~s/[^a-z| ]//g;$\= reverse "\U!$i";print;
master
 2006-04-03 12:45
#64258 #64258
User since
2003-10-20
610 Artikel
BenutzerIn
[default_avatar]
Das  Problem ist, dass das Objekt irgendwie noch gar nicht existiert... :-(

Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Aufruf:
     $SimpleButton = SimpleButton->new($id,$app,(65*$x),(25*$i),$img,$img2);


MODUL:

sub new {
    my $self = shift;
 
   $self->{ID} = shift;
   $self->{APP} = shift;
   $self->{X} = shift;
   $self->{Y} = shift;
   $self->{IMG} = shift;
   $self->{IMGHV} = shift;
   $self->{HV} = 0;
   
    my $Referenz = {};
    bless($Referenz,$self);



    print "  --  ",$self->{IMG}," ---";
    $self->draw($self->{IMG});

  
    return($Referenz);
}




sub draw
{
    my ($self, $img) = @_;
    print "IMG: $img"; 
}


Beide print-ausgaben sind leer.
(ob ich den Code nun mit shift, oder renee's vorschlage nutze :-( )\n\n

<!--EDIT|master|1144054030-->
$i='re5tsFam ^l\rep';$i=~s/[^a-z| ]//g;$\= reverse "\U!$i";print;
<< |< 1 2 3 4 >| >> 38 Einträge, 4 Seiten



View all threads created 2006-03-31 19:08.