lego/src/DragSwitchVBT.m3


Copyright (C) 1994, Digital Equipment Corp.

MODULE DragSwitchVBT;

IMPORT BtnVBTClass, ButtonVBT, FeedbackVBT, Filter, MultiClass, MultiFilter,
         SwitchVBT, VBT;

FROM VBT IMPORT ClickType;

REVEAL
  T = Public BRANDED OBJECT
      OVERRIDES
        init     := Init;
        callback := Callback;
        during   := During;
        mouse    := Mouse;
        position := Position;
        pre      := SwitchVBT.T.pre;
        post     := SwitchVBT.T.post;
        cancel   := SwitchVBT.T.cancel;
      END;

TYPE
  MC = SwitchVBT.MC OBJECT END;

PROCEDURE Init (v: T; f: FeedbackVBT.T): T =
  BEGIN
    EVAL ButtonVBT.T.init (v, f, Action);
    MultiClass.Be (v, NEW(MC));
    MultiClass.BeChild (v, MultiFilter.Child (f));
    RETURN v
  END Init;

PROCEDURE Callback (<* UNUSED *>          v : T;
                    <* UNUSED *> READONLY cd: VBT.MouseRec) =
  BEGIN
  END Callback;

PROCEDURE Action(selfAsButtonVBT: ButtonVBT.T; READONLY cd: VBT.MouseRec) =
  BEGIN
    NARROW(selfAsButtonVBT, T).callback(cd)
  END Action;

PROCEDURE During ( <* UNUSED *> v: T;
                   <* UNUSED *> READONLY cd: VBT.PositionRec) =
  BEGIN
  END During;

PROCEDURE Mouse(v: T; READONLY cd: VBT.MouseRec) =
  BEGIN
    Filter.T.mouse(v, cd);
    IF cd.clickType = ClickType.FirstDown THEN
      v.ready := TRUE;
      v.pre();
      VBT.SetCage(v, VBT.CageFromPosition(cd.cp, TRUE));
    ELSIF v.ready THEN
      v.ready := FALSE;
      IF cd.clickType = ClickType.LastUp AND NOT cd.cp.offScreen THEN
        v.action(v, cd);
        v.post();
      ELSE
        v.cancel();
      END;
    END;
  END Mouse;

PROCEDURE Position (v: T; READONLY cd: VBT.PositionRec) =
  BEGIN
    Filter.T.position(v, cd);
    IF v.ready THEN
      VBT.SetCage(v, VBT.CageFromPosition(cd.cp, TRUE));
      IF NOT cd.cp.offScreen THEN
        v.during(cd);
      END;
    END;
  END Position;

BEGIN
END DragSwitchVBT.