… | |
… | |
429 | |
429 | |
430 | # translate global coordinates to local coordinate system |
430 | # translate global coordinates to local coordinate system |
431 | sub coord2local { |
431 | sub coord2local { |
432 | my ($self, $x, $y) = @_; |
432 | my ($self, $x, $y) = @_; |
433 | |
433 | |
|
|
434 | Carp::confess unless $self->{parent};#d# |
|
|
435 | |
434 | $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y}) |
436 | $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y}) |
435 | } |
437 | } |
436 | |
438 | |
437 | # translate local coordinates to global coordinate system |
439 | # translate local coordinates to global coordinate system |
438 | sub coord2global { |
440 | sub coord2global { |
… | |
… | |
494 | my ($self, $signal, $cb) = @_; |
496 | my ($self, $signal, $cb) = @_; |
495 | |
497 | |
496 | push @{ $self->{signal_cb}{$signal} }, $cb; |
498 | push @{ $self->{signal_cb}{$signal} }, $cb; |
497 | } |
499 | } |
498 | |
500 | |
|
|
501 | my %has_coords = ( |
|
|
502 | button_down => 1, |
|
|
503 | button_up => 1, |
|
|
504 | mouse_motion => 1, |
|
|
505 | mouse_wheel => 1, |
|
|
506 | ); |
|
|
507 | |
499 | sub emit { |
508 | sub emit { |
500 | my ($self, $signal, @args) = @_; |
509 | my ($self, $signal, @args) = @_; |
501 | |
510 | |
502 | my @append |
511 | my @append |
503 | = ref $args[0] && $args[0]->isa ("CFClient::UI::Event") |
512 | = $has_coords{$signal} |
504 | ? $args[0]->xy ($self) |
513 | ? $args[0]->xy ($self) |
505 | : (); |
514 | : (); |
506 | |
515 | |
507 | #warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d# |
516 | #warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d# |
508 | |
517 | |