Tk::Canvas Tk::bind - führt callback nicht aus? (Graphische Oberflächen)

[thread]5268[/thread]

Tk::Canvas Tk::bind - führt callback nicht aus?

Leser: 1

PerlProfi

2006-12-09 18:14

User since
2006-11-29
340 Artikel
BenutzerIn
[default_avatar]

Ich habe da gerade ein Problem.

Ich würde mir gerne die Position auf der Kommandozeile ausgeben lassen, an der mit der Maus geklickt wurde.

Dazu habe ich folgendes probiert:

Code: (dl )

#!/usr/bin/perl
use strict;
use warnings 'all';
use Tk;

my $mw = tkinit;
my $c  = $mw->Canvas(-background => "white")->pack;

$c->Tk::bind("<Button-1>", [sub { shift; print "Pos: @_\n" }, Ev("x"), Ev("y")]);

MainLoop;

Das hat auch wunderbar funktioniert, aber wenn ich es dann in meiner eigentlichen Applikation verwenden möchte, wird der callback anscheinend gar nicht ausgeführt.

Mein Versuch:

Code: (dl )

        print "Jetzt werden die Bindings hinzugefuegt...\n";

        $c            -> Tk::bind    ("<Button-1>", [
        sub {
            shift;
            my @op = @{$r->{pos}};
            my @np = getXY(@_);

            print " OP: @op\n NP: @np\n";

            newpos($r, [$np[0]-$op[0], $np[1]-$op[1]]);
        }, Ev("x"), Ev("y") ]);

Ausgabe nachdem ich auf das Canvas geklickt habe:

Code: (dl )

Jetzt werden die Bindings hinzugefuegt...

Fehlermeldungen gibt es keine.

Bedanke mich schonmal für Hilfe,
MfG PerlProfi

renee

2006-12-09 18:38

User since
2003-08-04
14371 Artikel
ModeratorIn

was ist $r, was macht getXY, was macht newpos?

Das hier geht bei mir:

Code: (dl )

#!/usr/bin/perl
use strict;
use warnings 'all';
use Tk;

my $mw = tkinit;
my $c  = $mw->Canvas(-background => "white")->pack;

        print "Jetzt werden die Bindings hinzugefuegt...\n";

        $c            -> Tk::bind    ("<Button-1>", [
        sub {
            shift;
#            my @op = @{$r->{pos}};
            my @np = getXY(@_);

            print " OP: \@op\n NP: @np\n";

#            newpos($r, [$np[0]-$op[0], $np[1]-$op[1]]);
        }, Ev("x"), Ev("y") ]);

MainLoop;

sub getXY{
    return @_;
}

Also die Sub wird ausgeführt...

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/

PerlProfi

2006-12-09 18:49

User since
2006-11-29
340 Artikel
BenutzerIn
[default_avatar]

Ich kann mir nicht vorstellen, dass es etwas damit zu tun hat.

Aber gut, $r ist ein Roboter-Objekt.
$r->{pos} ist eine Arrayreferenz mit x und y Koordinate eines 2D Feldes.

newpos() bewegt den Roboter in x und y Richtung: newpos(robot, x-amount, y-amount)

getXY() liefert einfach nur die x und y position des feldes zurück.
Die x und y Position des Canvas werden übergeben:

Code: (dl )

sub getXY
{
    my($xp, $yp) = @_;
      ($xp, $yp) = (int(($xp+1)/20), int(($yp+1)/20));

    return ($xp, $yp);
} # getXY

Ich habe gerade dein Programm getestet, es läuft auch bei mir, ich weiß einfach nicht wo mein Fehler liegt.

MfG PerlProfi

//EDIT:
Ich hatte noch einen Denkfehler drin, aber leider wurde das Problem trotzdem nicht gelöst.

So sieht mein bind() Aufruf eigentlich aus:

Code: (dl )

        print "Jetzt werden die Bindings hinzugefuegt...\n";

        $c            -> Tk::bind    ("<Button-1>", [
        sub {
            shift;
            my @op = @{$r->{pos}};
            my @np = @_;

            print " OP: @op\n NP: @np\n";

            newpos($r, [$np[0]-$op[0], $np[1]-$op[1]]);
            @{$r->{pos}} = (getXY(@_));
        }, Ev("x"), Ev("y") ]);

MfG PerlProfi\n\n

renee

2006-12-09 18:59

User since
2003-08-04
14371 Artikel
ModeratorIn

Zeig mal etwas mehr von Deinem Code...

PerlProfi

2006-12-09 19:06

User since
2006-11-29
340 Artikel
BenutzerIn
[default_avatar]

Ok, ich versuchs mal, aber das ist nicht so einfach, das sind 7 Module, und das, das die GUI erstellt hat um die 2000 Zeilen.

Eventuell hilft das:

Code: (dl )

#
# change the Roboter Map
#
sub arbfeld_aendern
{
    my $self = shift;

    $self->{robot}->einschalten;
    $self->{stop} = 1;
    $self->{map_is_renewed} = 0;

    my $i    = 0;
    my $tl = $self->{mw}        -> Toplevel    (-title        => "Roboter Map verändern");

    foreach (qw/Blickrichtung: Material:/)
    {
        $tl            -> Label    (-text        => $_,
               
              -font        => "{Arial} 9 {bold}",
               
              -justify    => "left",
               
              -anchor    => "w")->grid
               
             (-column    => 0,
               
              -row        => $i++,
               
              -sticky    => "ew");
    }
    $tl              
  -> Label    (-text        => "Auf der Map positionieren:",
               
              -font        => "{Arial} 9 {bold}",
               
              -justify    => "left",
               
              -anchor    => "w")->grid
               
             (-column    => 0,
               
              -columnspan    => 2,
               
              -row        => $i,
               
              -sticky    => "ew");

    $i = 0;
    my $update =
    sub {
        updateInfo($self);
    };
    $tl              
  -> Optionmenu    (-options    => [["rechts", 0],
               
               
          ["unten", 90],
               
               
          ["links", 180],
               
               
          ["oben", 270]],
               
              -variable    => \$self->{robot}->{rot},
               
              -command    => sub { $self->{robot}->newlook; &$update })->grid
               
             (-column    => 1,
               
              -row        => $i++,
               
              -sticky    => "ew");
    $tl              
  -> Scale    (-from        => 0,
               
              -to        => 100,
               
              -orient    => "horizontal",
               
              -variable    => \$self->{robot}->{material}->[0],
               
              -command    => $update)->grid
               
             (-column    => 1,
               
              -row        => $i++,
               
              -sticky    => "ew");

    my $mode = "wiki";
    foreach ([qw/Wiki wiki/], [qw/Wände wall/], [qw/Gegenstände item/])
    {
        $tl            -> Radiobutton    (-text        => $_->[0],
               
              -value        => $_->[1],
               
              -variable    => \$mode,
               
              -anchor    => "w",
               
              -command    => sub { bind_map($self, $mode) })->grid
               
             (-column    => 1,
               
              -row        => ++$i,
               
              -sticky    => "ew");
    }

    $tl              
  -> Button    (-text        => "Abbrechen",
               
              -font        => "{Arial} 9 {bold}",
               
              -command    => sub { bind_map($self, "no"); $tl->destroy })->grid
               
             (-column    => 0,
               
              -row        => $i+2,
               
              -sticky    => "ew");
    $tl              
  -> Button    (-text        => "OK",
               
              -font        => "{Arial} 9 {bold}",
               
              -command    => sub {})->grid
               
             (-column    => 1,
               
              -row        => $i+2,
               
              -sticky    => "ew");


    my($cols, $rows) = $tl->gridSize();
    for $i (1..$cols) {
        $tl->gridColumnconfigure($i-1, -weight => 1);
    }
    for $i (1..$rows) {
        $tl->gridRowconfigure($i-1, -weight => 1);
    }
} # arbfeld_aendern

#
# bind some special events, defined by $mode, to the Roboter Map
#
sub bind_map
{
    my($self, $mode) = @_;
    my $r = $self->{robot};
    my $c = $r->{c};

    if ($mode =~ "no")
    {
        $c            -> Tk::bind    ("<Button-1>", "NoOp");
        $c            -> Tk::bind    ("<Button-3>", "NoOp");
    }
    elsif ($mode =~ "wiki")
    {
        print "Jetzt werden die Bindings hinzugefuegt...\n";

        $c            -> Tk::bind    ("<Button-1>", [
        sub {
            shift;
            my @op = @{$r->{pos}};
            my @np = @_;

            print " OP: @op\n NP: @np\n";

            newpos($r, [$np[0]-$op[0], $np[1]-$op[1]]);
            @{$r->{pos}} = (getXY(@_));
        }, Ev("x"), Ev("y") ]);
    }
} # bind_map

Ansonsten probier ich mal das mit den bindings in einem Skript zusammenzufassen ohne den Kontext zu verlieren.

MfG PerlProfi

//EDIT: Entschuldigt die vielen komischen whitespaces, ich benutze Tabs zum Einrücken...\n\n

PerlProfi

2006-12-09 20:03

User since
2006-11-29
340 Artikel
BenutzerIn
[default_avatar]

Jetzt hab ichs geschafft!
Das Canvas war Scrolled, deshalb hat sich bind() nur auf den Frame bezogen und nicht auf das Canvas.

@renee danke für die schnelle Hilfe

MfG PerlProfi

View all threads created 2006-12-09 18:14.