| |
package Window;
my $_id = 1;
sub new { bless { _id => $_id++ }, $_[0] }
my %table;
sub init {
my ($param1,$param2,$param3,$handler) = @_;
$table{$param1}{$param2}{$param3} = $handler;
}
init "Window", "Event", "Mode"
=> sub { print "Window $_[0]->{_id} can't handle a ",
ref($_[1]), " event in ", ref($_[2]), " mode\n" };
init "Window", "Event", "OffMode"
=> sub { print "No window operations available in OffMode\n" };
init "ModalWindow", "ReshapeEvent", "Mode"
=> sub { print "Modal windows can't handle reshape events\n" };
init "ModalWindow", "AcceptEvent", "Mode"
=> sub { print "Modal window $_[0]->{_id} accepts!\n" };
init "ModalWindow", "AcceptEvent", "OffMode"
=> sub { print "Modal window $_[0]->{_id} can't accept in OffMode!\n" };
init "MovableWindow", "MoveEvent", "OnMode"
=> sub { print "Moving window $_[0]->{_id}!\n" };
init "ResizableWindow", "ResizeEvent", "OnMode"
=> sub { print "Resizing window $_[0]->{_id}!\n" };
init "ResizableWindow", "MoveAndResizeEvent", "OnMode"
=> sub { print "Moving and resizing window $_[0]->{_id}!\n" };
sub ancestors {
no strict "refs";
my @ancestors = @_;
for (my $i=0; $i(@ancestors; $i++)
{ splice @ancestors, $i+1, 0, @{"$ancestors[$i]::ISA"} }
return @ancestors;
}
sub receive_event {
my ($type1, $type2, $type3) = map {ref} @_;
my $handler = $table{$type1}{$type2}{$type3};
if (!$handler) {
my @ancestors1 = ancestors($type1);
my @ancestors2 = ancestors($type2);
my @ancestors3 = ancestors($type3);
SEARCH: foreach my $anc1 ( @ancestors1 ) {
foreach my $anc2 ( @ancestors2 ) {
foreach my $anc3 ( @ancestors3 ) {
$handler = $table{$anc1}{$anc2}{$anc3};
next unless $handler;
$table{$type1}{$type2}{$type3} = $handler;
last SEARCH;
}
}
}
}
die "No handler defined for ($type1,$type2,$type3)"
unless $handler;
$handler->(@_);
}
package ModalWindow; @ISA = qw( Window );
package MovableWindow; @ISA = qw( Window );
package ResizableWindow; @ISA = qw( MovableWindow );
|