MouseTrapTest: Commander.CommandProc ~ {
parent: ViewerClasses.Viewer ¬ ViewerOps.CreateViewer[flavor: $MTTest, info: [name: "MouseTrap Test", openHeight: 150+14+18, scrollable: FALSE]];
[] ¬ ViewerOps.CreateViewer[flavor: $MTRoundWrap, info: [parent: parent, wx: 10, wy: 10, ww: 130, wh: 130, border: FALSE]];
[] ¬ ViewerOps.CreateViewer[flavor: $MTRound, info: [parent: parent, wx: 150, wy: 10, ww: 130, wh: 130, border: FALSE]];
[] ¬ ViewerOps.CreateViewer[flavor: $MTBoxWrap, info: [parent: parent, wx: 290, wy: 10, ww: 130, wh: 130]];
[] ¬ ViewerOps.CreateViewer[flavor: $MTBox, info: [parent: parent, wx: 430, wy: 10, ww: 130, wh: 130]];
ViewerOps.OpenIcon[parent];
};
Paint: ViewerClasses.PaintProc ~ {
SELECT self.class.flavor
FROM
$MTTest => {
Draw2d.Label[context, [010, 150], "Round (wrapping)"];
Draw2d.Label[context, [150, 150], "Round"];
Draw2d.Label[context, [290, 150], "Box (wrapping)"];
Draw2d.Label[context, [430, 150], "Box"];
};
$MTRoundWrap, $MTRound => Draw2d.Circle[context, [self.ww/2, self.wh/2], self.ww/2];
ENDCASE;
};
Notify: ViewerClasses.NotifyProc ~ {
IF input.rest.first = $down
THEN
SELECT self.class.flavor
FROM
$MTRound => MouseTrap.TrapTillMouseUp[self, TRUE, FALSE];
$MTRoundWrap => MouseTrap.TrapTillMouseUp[self, TRUE, TRUE];
$MTBox => MouseTrap.TrapTillMouseUp[self, FALSE, FALSE];
$MTBoxWrap => MouseTrap.TrapTillMouseUp[self, FALSE, TRUE];
ENDCASE;
};
FOR l:
LIST
OF
ATOM ¬
LIST[$MTTest, $MTRoundWrap, $MTRound, $MTBoxWrap, $MTBox],
l.rest
WHILE l #
NIL
DO
ViewerOps.RegisterViewerClass[l.first,
NEW[ViewerClasses.ViewerClassRec ¬
[paint: Paint, notify: Notify, tipTable: tipTable]]];
ENDLOOP;