(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* by Steve Glassman, Mark Manasse and Greg Nelson           *)
(* Last modified on Mon Feb 24 13:53:01 PST 1992 by muller   *)
(*      modified on Sun Nov 10 18:20:22 PST 1991 by gnelson  *)
(*      modified on Wed Sep 11 15:27:59 PDT 1991 by msm      *)
<*PRAGMA LL*>

MODULE ButtonVBT;

IMPORT VBT, Filter, Rect, HighlightVBT, BtnVBTClass, Split, 
  VBTClass, Axis, PackSplit, PaintOp;

FROM VBT IMPORT ClickType;

REVEAL 
  T = BtnVBTClass.T BRANDED OBJECT
    highlighter: HighlightVBT.T := NIL
  OVERRIDES 
    mouse := Mouse;
    position := Position;
    shape := Shape;
    pre := Pre;
    post := Post;
    cancel := Post; (*sic*)
    init := Be
  END;
  
PROCEDURE Be(v: T; ch: VBT.T; p: Proc; ref: REFANY := NIL): T RAISES {} =
  BEGIN
    v.action := p;
    IF ref # NIL THEN VBT.PutProp(v, ref) END;
    EVAL Filter.T.init(v, ch);
    RETURN v
  END Be;

PROCEDURE New(
    ch: VBT.T; 
    action: Proc; 
    ref: REFANY := NIL): T RAISES {} =
  BEGIN
    RETURN Be(NEW(T), ch, action, ref)
  END New;
  
PROCEDURE Mouse(v: T; READONLY cd: VBT.MouseRec) RAISES {} =
  BEGIN
    Filter.T.mouse(v, cd);
    IF cd.clickType = ClickType.FirstDown THEN
      v.ready := TRUE;
      v.armed := TRUE;
      v.pre();
      VBT.SetCage(v, VBT.InsideCage)
    ELSE
      IF (cd.clickType = ClickType.LastUp) AND NOT cd.cp.gone AND v.armed
      THEN
        IF NOT v.ready THEN v.pre() END;
        v.action(v, cd);
        v.post()
      ELSIF v.ready THEN
        v.cancel()
      END;
      v.ready := FALSE;
      v.armed := FALSE
    END
  END Mouse;

PROCEDURE Position(v: T; READONLY cd: VBT.PositionRec) RAISES {} =
  BEGIN
    Filter.T.position(v, cd);
    IF v.armed THEN
      IF cd.cp.gone THEN
        IF v.ready THEN
          v.cancel();
          v.ready := FALSE
        END;
        VBT.SetCage(v, VBT.GoneCage)
      ELSE
        IF NOT v.ready THEN
          v.ready := TRUE;
          v.pre()
        END;
        VBT.SetCage(v, VBT.InsideCage)
      END
    ELSE
      VBT.SetCage(v, VBT.EverywhereCage)
    END
  END Position;

PROCEDURE Pre(v: T) RAISES {} =
  BEGIN
    v.highlighter := HighlightVBT.Find(v);
    HighlightVBT.Invert(v.highlighter, VBT.Domain(v), 99999)
  END Pre;

PROCEDURE Post(v: T) RAISES {} =
  BEGIN
    HighlightVBT.SetRect(v.highlighter, Rect.Empty, 0);
    v.highlighter := NIL
  END Post;

PROCEDURE Shape(v: T; ax: Axis.T; n: CARDINAL): VBT.SizeRange RAISES {} =
  BEGIN
    WITH sh = VBTClass.GetShape(Filter.Child(v), ax, n) DO
      RETURN VBT.SizeRange{lo := sh.lo, hi := sh.lo+1, pref := sh.lo}
    END
  END Shape;

PROCEDURE MenuBar(
  ch0, ch1, ch2, ch3, ch4, ch5, ch6, ch7, ch8, ch9: VBT.T := NIL;
  op: PaintOp.T := PaintOp.Bg)
  : PackSplit.T RAISES {} =
  VAR res := NEW(Bar);
  BEGIN
    EVAL PackSplit.T.init(res, op := op);
    Split.AddChild(res, ch0, ch1, ch2, ch3, ch4, ch5, ch6, ch7, ch8, ch9);
    RETURN res
  END MenuBar;

PROCEDURE BarShape(v: Bar; ax: Axis.T; n: CARDINAL): VBT.SizeRange RAISES {} =
  VAR sh := PackSplit.T.shape(v, ax, n); BEGIN
    IF ax # PackSplit.AxisOf(v) THEN sh.hi := sh.lo+1; sh.pref := sh.lo END;
    RETURN sh
  END BarShape;

TYPE Bar = PackSplit.T OBJECT OVERRIDES shape := BarShape END;

BEGIN END ButtonVBT.