1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
use 5.005;
# SET UP A WINDOW HIERARCHY
package Window;
my $ids = 1;
sub new { bless { id=>$ids++ }, ref($_[0])||$_[0] }
use Class::Multimethods;
multimethod handle => (Window, Command, OffMode) => sub
{
print "No window operations available in OffMode\n";
};
multimethod handle => (Window, '#', Mode) => sub
{};
multimethod handle => (Window, Command, '*') => sub
{};
multimethod handle => (Window, Command, Mode) => sub
{
print "Window $_[0]->{id} can't handle a ",
ref($_[1]), " command in ",
ref($_[2]), " mode\n";
};
package ModalWindow; @ISA = qw( Window );
use Class::Multimethods;
multimethod handle => (ModalWindow, ReshapeCommand, Mode) => sub
{
print "Modal windows can't handle reshape commands\n";
};
multimethod handle => (ModalWindow, Accept, OffMode) => sub
{
print "Modal window $_[0]->{id} can't accept in OffMode!\n";
};
multimethod handle => (ModalWindow, Accept, Mode) => sub
{
print "Modal window $_[0]->{id} accepts!\n";
};
package MovableWindow; @ISA = qw( Window );
use Class::Multimethods;
multimethod handle => (MovableWindow, Move, Mode) => sub
{
print "Moving window $_[0]->{id}!\n";
};
multimethod handle => (MovableWindow, ReshapeCommand, OnMode) => sub
{
print "Moving window $_[0]->{id}!\n";
};
package ResizableWindow; @ISA = qw( MovableWindow );
use Class::Multimethods;
multimethod handle => (ResizableWindow, Resize, OnMode) => sub
{
print "Resizing window $_[0]->{id}!\n";
};
multimethod handle => (ResizableWindow, MoveAndResize, OnMode) => sub
{
print "Moving and resizing window $_[0]->{id}!\n";
};
multimethod handle => (ResizableWindow, Command) => sub
{
print "Moving and resizing window $_[0]->{id}!\n";
};
# SET UP A COMMAND HIERARCHY
package Command;
sub new { bless {}, ref($_[0])||$_[0] }
package ReshapeCommand; @ISA = qw( Command );
package Accept; @ISA = qw( Command );
package Move; @ISA = qw( ReshapeCommand );
package Resize; @ISA = qw( ReshapeCommand );
package MoveAndResize; @ISA = qw( Move Resize );
# SET UP A MODE HIERARCHY
package Mode;
sub new { bless {}, ref($_[0])||$_[0] }
package OnMode; @ISA = qw( Mode );
package ModalMode; @ISA = qw( Mode );
package OffMode; @ISA = qw( Mode );
package main;
use Class::Multimethods;
Class::Multimethods::analyse spindle;
Class::Multimethods::analyse handle
=> [ResizableWindow, Command, OnMode],
[MovableWindow, Move, OnMode];
Class::Multimethods::analyse handle;
# CHECK 100% success
multimethod perfect => ('#') => sub { "number\n" };
multimethod perfect => ('$') => sub { "scalar\n" };
Class::Multimethods::analyse perfect;
|
