OO-Button-Modul: für SDL (ab geht um OO) (Seite 4) (Allgemeines zu Perl)

[thread]7847[/thread]

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

Leser: 1

master

2006-04-06 17:22

User since
2003-10-20
610 Artikel
BenutzerIn
[default_avatar]

sorry X->new habe ich vergessen ist nun korrigiert oben...

Am Besten stelle ich gleich mal nochmal den ganzen Code rein... Code-Komplett:

"los.pl"

Code: (dl )

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

#use SDL::X;


my $container = X->new();
$GFXButton = X::GFXButton;


$|=1;

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

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

$event = new SDL::Event();
$img = SDL::Surface->new( -name => 'x.png' ); $img2 = SDL::Surface->new( -name => 'x_on.png' ); $img3 = SDL::Surface->new( -name => 'x_click.png' );





#Button hinzufügen...(test)
for my $i (0..15) { for my $x (0..10) { $id++;
$container->GFXButton_add($id,$app,(65*$x),(25*$i),$img,$img2,$img3, 'loslos'); }}





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


    ($active_element, $B_event_sub) = $container->checkall($event->button_x,$event->button_y);


    if($etype eq SDL_MOUSEBUTTONDOWN && $active_element)
    {
         $active_element->button_down();
         if($B_event_sub) {&{$B_event_sub}($active_element);};
    }


    #if ( $active_element )  { $active_element->set('PRESSED',1); };
    if($etype eq SDL_MOUSEBUTTONUP) {$GFXButton->buttons_up($container);$GFXButton->destroy_buttons($container);}

}








#Button Event
sub loslos
{
    my $self  = shift; my ($ID, $IMG ) = $self->get("ID", "IMG");
    print "\n   $ID - $IMG   ";
}

x.pm

Code: (dl )

package X;

use X::GFXButton;
my $GFXButton = X::GFXButton;



#Erzeugen
sub new {
    my ($class,@params) = @_;
    my $self = {};
    bless($self,$class);
     $self->{BUTTS} = [];

   return($self);
}






#------------ Alle Elemente Prüfen --------------------
sub checkall
{
    my ($self, $mx, $my) = @_;
    my $active_element = 0;
    my $B_event_sub = 0;

    #Buttons Prüfen
    for(@{$self->{BUTTS}}) {
        if($_->check_button($mx,$my)){$active_element = $_;}
    }



    #Events bearbeiten....
    if($active_element) {$B_event_sub = $active_element->{DOSUB};}
    return ($active_element, $B_event_sub);    #Object and the sub
}






#------------------------ ELEMENTE ------------------------

sub GFXButton_add
{return $GFXButton->new(@_);}

1;

GFXButton.pm

Code: (dl )

package X::GFXButton;
use strict;




#----------------------------------------------------- INI --------------------------------------------------------




#Erzeugen
sub new {


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

    $self->{CONTAINER} = shift(@params);        #Container
    $self->{ID} = shift(@params);         #ID oder Name
    $self->{APP} = shift(@params); #SDL APP
    $self->{X} = shift(@params);
    $self->{Y} = shift(@params);
    $self->{IMG} = shift(@params);  #IMG normal
    $self->{IMGHV} = shift(@params);   #IMG hover
    $self->{IMG_click} = shift(@params);            #IMG click
    $self->{DOSUB} = shift(@params);#Button's sub
    $self->{TXT} = shift(@params); #Button's Text


    $self->{HV} = 0; #Hover state
    $self->draw($self->{IMG}); #Display

    push( @{$self->{CONTAINER}->{BUTTS}}   ,  $self);


    return($self);
}








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

    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->{PRESSED} eq 1){$self->draw($self->{IMG_click});} else
        {
            if(not  $self->{HV}) {$self->{HV}=1; $self->draw($self->{IMGHV});}
        }


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

    return 0;
}











#---------------------------------------------------------- CODE OK ----------------------------------------------------------

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



#Button geklickt darstellen
sub button_down { $_->{PRESSED} = 1;}

#Bei MausUP Buttons normal zeichnen
sub buttons_up  {
my ($self, $container) = @_;
for(@{$container->{BUTTS}})
 {$_->{PRESSED} = 0; $_->draw($_->{IMG});}
}


#Button_on
#Button_off

#Buttons_on
#Buttons_off


#Buttons nicht mehr prüfen
sub destroy_buttons {
my ($self, $container) = @_;
$container->{BUTTS} = [];}




#Parameter zurückgeben (mehrere)
sub get
{my ($self, @values) = @_; my @out = ();for(@values) {push(@out,$self->{"$_"}); } return @out;}

#Einelnen Parameter setzen
sub set
{my ($self, $param, $value) = @_;  $self->{$param} = $value;}


1;

Erreichen tu ich ja alles was ich will. nur ist es noch zu kompliziert. Solche sachen gefallen mir nicht wirklich:

Code: (dl )

1
2

sub GFXButton_add
{return $GFXButton->new(@_);}

Wär mir lieber wenn ich direkt über den conti das ansprechen könnte also z. B. so in der Art

conti->GFXButton->new
(ohne diese Umleitung oben im X.pm zu machen)

Oder:

Code: (dl )

#Bei MausUP Buttons normal zeichnen
sub buttons_up  {
my ($self, $container) = @_;
for(@{$container->{BUTTS}})
 {$_->{PRESSED} = 0; $_->draw($_->{IMG});}
}


Aufruf:
$GFXButton->buttons_up($container);

wär schöner, wenn ich irgendwie eine andere lösung hätte
$container mitzugeben ist ja unnötig,
jedes objekt hat die conti referenz, aber hier greiffe ich ja auf eine funktion von GFXButton zu, also kein objekt.

klar ich könnte z.b. buttons_up auch in X.pm, statt GFX_button.pm einbauen, aber
ich will im Prinzip die ganze funktionaltät von GFXButton auch dort lassen..

X.pm ist der Container.\n\n

$i='re5tsFam ^l\rep';$i=~s/[^a-z| ]//g;$\= reverse "\U!$i";print;

ptk

2006-04-07 00:59

User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]

Wenn du eine Rückreferenz von Button auf Container brauchst: dann übergib einfach die Container-Referenz und speichere sie irgendwo im Button-Objekt. Denk aber daran, dass du diese Referenz per Scalar::Util::weaken "schwach" machst, weil du dir ansonsten eine zirkuläre Referenz baust, die Perl nicht automatisch auflösen kann.

Beispielcode:

Code: (dl )

$container->add_button(%button_args);

{
   package Container;
   sub add_button {
      my($self, %button_args) = @_;
      my $button = Button->new(%button_args, -container => $self);
      push @{$self->buttons}, $button;
      $button;
   }
}

Hier sieht man auch den Tk-Stil der "named parameters". Eine Sache, die bei Perl6 viel leichter sein wird und auf die ich mich schon freue.

master

2006-04-07 18:21

User since
2003-10-20
610 Artikel
BenutzerIn
[default_avatar]

Quote
Wenn du eine Rückreferenz von Button auf Container brauchst: dann übergib einfach die Container-Referenz und speichere sie irgendwo im Button-Objekt. Denk aber daran, dass du diese Referenz per Scalar::Util::weaken "schwach" machst, weil du dir ansonsten eine zirkuläre Referenz baust, die Perl nicht automatisch auflösen kann.

Das mache ich ja bereits (siehe mein code)
Aber kannst du mir das mit der Referenz nochmal erklären, mit einfacheren Worten? Ist das nicht ok wie ich das mache?

Hier zur übersicht:

Code: (dl )

my $container = X->new();  #conti erzeugen

$container->GFXButton_add(PARAMENTer);

#--sub-- des contis, gibt
$GFXButton = X::GFXButton;

sub GFXButton_add
{return $GFXButton->new(@_);}  



#--new-methode von GFXButton ---



#Erzeugen
sub new {

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

    $self->{CONTAINER} = shift(@params);        #Container
    $self->{ID} = shift(@params);              &n
bsp; #ID oder Name
    $self->{APP} = shift(@params);            


......
......
......
push( @{$self->{CONTAINER}->{BUTTS} }   ,  $self);


    return($self);
}

Beim Push wird das Button element in den Array des Contis geworfen und am ende return $self.
somit habe ich im Hauptskript zugriff auf jedes GFXButton-Objekt.

$i='re5tsFam ^l\rep';$i=~s/[^a-z| ]//g;$\= reverse "\U!$i";print;

ptk

2006-04-07 23:21

User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]

Die Rückreferenz habe ich übersehen. Mit der schwachen Referenz meine ich das so:

Code: (dl )

use Scalar::Util qw(weaken);
...
sub GFXButton::new {
    my($class, $container, ...) = @_;
    weaken $container;
    ... Rest des Codes ...
}

Und hier noch etwas Code zum Spielen mit weaken(). In der Ausgabe von Dump() kann man den Referenz-Zählen sehen. Bei der Verwendung von weaken geht der Zähler wieder um eins runter. Und DESTROY zeigt an, an welcher Stelle das Objekt freigegeben wird. Kommentiert man den weaken()-Aufruf aus, ändert sich diese Ausgabe zu "during global destruction" --- ein Zeichen für einen möglichen Memory Leak durch Verwendung von zirkulären Referenzen.

Code: (dl )

use Scalar::Util qw(weaken);
use Devel::Peek;

sub Container::DESTROY {
    warn "Container $_[0] is destroyed!";
}

{
    my $container = bless {}, "Container";
    Dump $container;
    my $button = bless { container => $container }, "Button";
    push @{$container->{buttons}}, $button;
    Dump $container;
    weaken $button->{container};
    Dump $container;
}

__END__

master

2006-04-10 10:37

User since
2003-10-20
610 Artikel
BenutzerIn
[default_avatar]

@ptk:

?? muss ich ihn hier auch abschwächen? Ich meine ich übergebe ja dem neuen Objekt den Container. Wenn ja -> Wie? (am besten Einzeiler)

Code: (dl )

$self->{CONTAINER} = shift(@params); #Container

----------------
Die Zeichungsmethode habe ich nun um über 50% schneller gemacht. Hier die Werte auf einem Pentium 4 um 50'000 Buttons zu zeichnen:

Alt: 11 s
Neu: 5 s
----------------\n\n

$i='re5tsFam ^l\rep';$i=~s/[^a-z| ]//g;$\= reverse "\U!$i";print;

ptk

2006-04-10 23:28

User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]

Du hast eine Referenz vom Button auf den Container und eine Referenz vom Container auf den Button. Um die Zirkularität aufzulösen, reicht es im Allgemeinen, nur einmal zu schwächen.

Matze

2006-04-13 15:03

User since
2005-08-29
222 Artikel
BenutzerIn

Hast du schon probiert die Buttons zeichnen zu lassen, laso ohne Bilder ?

So würde ich es machen:

Code: (dl )

  my $self = shift;

  my $bg = shift;
  my $fg = shift;

  # Button Objekt, Fordergrund- und Hintergrundfarbe
  # werden übergeben.

  my $width = int($self->{FONT}->width($self->{TEXT}) + 16);
  my $height = int($self->{SIZE} + 20);

  # Die Höhe und Breite von $border (s.u.) bekommst du
  # durch den Font, den man benutzen möchte und eine
  # SIZE Option, welche der -size Option im Font gleicht.

  # Rechtecke zeichnen:

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

  my $inline = SDL::Rect->new
  (-height => $height-4,
   -width => $width-4,
   -x => $self->{X}+2,
   -y => $self->{Y}+2);

  # $inline kleiner als $border, da man ja den Rand auch noch
  # sehen soll.

  # Rechtecke füllen:

  $self->{APP} -> fill($border,$bg);
  $self->{APP} -> fill($inline,$fg);

  # Text-Position berechnen:
  #  X bekommst du, indem du einfach die X-Position des
  #  Rechteckes + 8 nimmst.
  #  Y bekommst du, indem du die Höhe des Rechteckes / 2
  #  teilst, die Y-Position des Rechteckes addierst und die
  #  Höhe des Textes anhand des benutzten Fonts / 2 geteilt
  #  subtraierst.
  # Allerdings nur, wenn du möchtest, dass der Text in der
  # Mitte steht und nicht so dicht am Rand.

  my $nx  = $self->{X} + 8;
  my $ny  = int((($height / 2) + $self->{Y}) - $self->{FONT}->height($self->{TEXT}) / 2);

  # Text ausgeben:

  $self->{FONT} -> print ($self->{APP},$nx,$ny,$self->{TEXT});

  # Bereich 'neu laden' und
  # APP flippen:

  $self->{APP} -> update($border);
  $self->{APP} -> flip ();

Zu dem Container würde ich sagen, dass es ausreicht wenn man eine add() Funktion zur Verfügung hat an die das jeweilige Widget übergeben werden kann.
Schließlich ist es dann(zumindest sieht es für mich so aus) dynamischer.

Jedes Widget bekommt eine check Funktionen und der Construcor behält immer den selben Namen(z.B.: new).

Und wie ptk schon sagt, kannst du ja, wenn du es unbedingt brauchst, den Container mit an new() übergeben.

MfG. Matze

Mit freundlichen Grüßen: Matze

master

2006-04-13 15:26

User since
2003-10-20
610 Artikel
BenutzerIn
[default_avatar]

@Matze

Dein Ansatz geht dahin, dass der GFXButton auch Text erlauben soll..

Ich habe mir das lange überlegt und hatte es bereits implementiert. Man konnte TTF fonts darstellen usw. aber das Ganze habe ich nun zurück geändert.

Grund:
"GFXButton.pm" soll nur Grafiken darstellen

"KombiButton.pm" (oder Ev. auch TextButton)

Wird dann aus Speedgründen eine Kombination sein.

Ev. wird zuvor der Button mit GD konstruiert
(das ist eingies schneller, als per SDL)
Danach der Textbutton einfach dem GFXButton übergeben.

Ich will defintiv die Trennung haben.

GFXButton.pm soll nur Bilder darstellen.
Selbst die Events habe ich extra nicht implementiert.
Da Sie ja per SDL so oder so abgefragt werden müssen

Mir scheint der GD-Weg jedoch die beste Idee..
Im Notfall kann ich immer noch (siehe unten ->{TXT} )nutzen für die alte Methode (dein Vorschlag).

Code: (dl )

#Umleitung zur fastdraw-Methode
sub draw_butt        {
$_[0]->{CONTAINER}->fastdraw($_[1], $_[0]->{X}, $_[0]->{Y});

if($_[0]->{TXT} ne '') {}   #Im Notfall wieder einbauen
}

\n\n

$i='re5tsFam ^l\rep';$i=~s/[^a-z| ]//g;$\= reverse "\U!$i";print;

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