| … | |
… | |
| 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 | |
