(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Last modified on Thu Oct  1 22:38:42 PDT 1992 by mhb        *)
(*      modified on Tue Aug  4 17:24:32 PDT 1992 by meehan     *)
(*      modified on Tue Jun 16 13:08:38 PDT 1992 by muller     *)
(*      modified on Fri Mar 27 02:31:45 1992 by steveg     *)
(*      modified on Mon Dec  9 16:56:38 PST 1991 by meehan     *)

MODULE MarginFeedbackVBT;

IMPORT Axis, Feedback, FeedbackClass, HVSplit, Multi, MultiClass,
         Pixmap, PixmapVBT, Point, Pts, Rect, Region, Shadow,
         ShadowPaint, Split, Thread, VBT, VBTKitResources;

<* FATAL Thread.Alerted *>

REVEAL
  T = Public BRANDED OBJECT
        marginVBT: VBT.T
      OVERRIDES
        init := Init
      END;

REVEAL FC = FeedbackClass.T BRANDED OBJECT END;

REVEAL
  MC = MultiClass.T BRANDED OBJECT
       OVERRIDES
         replace  := Replace;
         succ     := Succ;
         pred     := Succ;
       END;

PROCEDURE Init (v            : T;
                ch           : VBT.T;
                marginVBT    : VBT.T;
                multiclass   : MC      := NIL;
                feedbackclass: FC      := NIL  ): T =
  BEGIN
    EVAL HVSplit.T.init (v, Axis.T.Hor, FALSE, -1, FALSE);
    IF feedbackclass = NIL THEN feedbackclass := NEW (FC) END;
    FeedbackClass.Be (v, feedbackclass);
    IF multiclass = NIL THEN multiclass := NEW (MC) END;
    MultiClass.Be (v, multiclass);
    Split.AddChild (v, marginVBT);
    IF ch # NIL THEN
      Split.AddChild (v, ch);
      MultiClass.BeChild (v, ch);
    END;
    v.marginVBT := marginVBT;
    Feedback.Normal (v);
    RETURN v
  END Init;

TYPE
  Flavor = {Check, Box, Bullet};
  OnOff = BOOLEAN;
  NE = {Normal, Excited};
  
VAR 
  mu := NEW(MUTEX);
  inited := ARRAY Flavor OF BOOLEAN {FALSE, FALSE, FALSE};
  
  pixmaps  : ARRAY Flavor, OnOff, NE OF Pixmap.T;
  styles   : ARRAY Flavor, OnOff, NE OF Shadow.Style;
  textures : ARRAY Flavor, OnOff, NE OF Pixmap.T;
 
TYPE
  FCWithPixmaps = FC OBJECT
                    flavor: Flavor;
                  OVERRIDES
                    normal  := Normal;
                    excited := Excited;
                  END;

PROCEDURE NewWithPixmaps (ch: VBT.T; blotVBT: BlotVBT; flavor: Flavor): T =
  BEGIN
    WITH v = NEW (T) DO
      EVAL v.init (ch, blotVBT);
      FeedbackClass.Be (v, NEW (FCWithPixmaps, flavor := flavor));
      Feedback.Normal (v);
      RETURN v;
    END
  END NewWithPixmaps;

PROCEDURE Show (fc: FCWithPixmaps; normalExcited: NE) =
  VAR
    v    : T := fc.vbt;
    onOff    := Feedback.GetState (v);
  BEGIN
    LOCK mu DO
      BlotVBTPut (
        v.marginVBT, pixmaps [fc.flavor, onOff, normalExcited],
        styles [fc.flavor, onOff, normalExcited],
        textures [fc.flavor, onOff, normalExcited])
    END
  END Show;

PROCEDURE Normal (fc: FCWithPixmaps) =
  BEGIN
   Show(fc, NE.Normal);
  END Normal;

PROCEDURE Excited (fc: FCWithPixmaps) =
  BEGIN
   Show(fc, NE.Excited);
  END Excited;


(************************** Check Mark  ****************************)

PROCEDURE NewCheck (ch: VBT.T; shadow: Shadow.T := NIL): T =
  BEGIN
    GetCheckResources();
    RETURN NewWithPixmaps(ch, NewBlotVBT(shadow), Flavor.Check);
  END NewCheck;

PROCEDURE GetCheckResources () =
  BEGIN
    LOCK mu DO
      IF inited [Flavor.Check] THEN RETURN END;
      pixmaps [Flavor.Check, FALSE, NE.Normal] :=
        VBTKitResources.GetPixmap ("checkMarkOff");
      pixmaps [Flavor.Check, TRUE, NE.Normal] :=
        VBTKitResources.GetPixmap ("checkMarkOn");
      pixmaps [Flavor.Check, FALSE, NE.Excited] :=
        VBTKitResources.GetPixmap ("checkMarkOffExcited");
      pixmaps [Flavor.Check, TRUE, NE.Excited] :=
        VBTKitResources.GetPixmap ("checkMarkOnExcited");
      inited [Flavor.Check] := TRUE;
    END
  END GetCheckResources;


(**************************  Box  ****************************)

PROCEDURE NewBox (ch: VBT.T; shadow: Shadow.T := NIL): T =
  BEGIN
    GetBoxResources();
    RETURN
      NewWithPixmaps(
        ch, NewBlotVBT(shadow, Looks.Square, 2.0), Flavor.Box);
  END NewBox;

PROCEDURE GetBoxResources () =
  BEGIN
    LOCK mu DO
      IF inited[Flavor.Box] THEN RETURN END;
      pixmaps[Flavor.Box, FALSE, NE.Normal] :=
        VBTKitResources.GetPixmap("checkOff");
      styles[Flavor.Box, FALSE, NE.Normal] :=
        Shadow.Style.Raised;
      textures[Flavor.Box, FALSE, NE.Normal] := Pixmap.Empty;
      pixmaps[Flavor.Box, TRUE, NE.Normal] :=
        VBTKitResources.GetPixmap("checkOn");
      styles[Flavor.Box, TRUE, NE.Normal] :=
        Shadow.Style.Lowered;
      textures[Flavor.Box, TRUE, NE.Normal] := Pixmap.Solid;
      pixmaps[Flavor.Box, FALSE, NE.Excited] :=
        VBTKitResources.GetPixmap("checkOffExcited");
      styles[Flavor.Box, FALSE, NE.Excited] :=
        Shadow.Style.Raised;
      textures[Flavor.Box, FALSE, NE.Excited] := Pixmap.Gray;
      pixmaps[Flavor.Box, TRUE, NE.Excited] :=
        VBTKitResources.GetPixmap("checkOnExcited");
      styles[Flavor.Box, TRUE, NE.Excited] :=
        Shadow.Style.Lowered;
      textures[Flavor.Box, TRUE, NE.Excited] := Pixmap.Gray;
      inited[Flavor.Box] := TRUE;
    END
  END GetBoxResources;


(**************************  Radio  ****************************)

PROCEDURE NewBullet (ch: VBT.T; shadow: Shadow.T := NIL): T =
  BEGIN
    GetBulletResources ();
    RETURN NewWithPixmaps (
             ch, NewBlotVBT (shadow, Looks.Diamond, 1.0),
             Flavor.Bullet);
  END NewBullet;

PROCEDURE GetBulletResources () =
  BEGIN
    LOCK mu DO
      IF inited[Flavor.Bullet] THEN RETURN END;
      pixmaps[Flavor.Bullet, FALSE, NE.Normal] :=
        VBTKitResources.GetPixmap("radioOff");
      styles[Flavor.Bullet, FALSE, NE.Normal] :=
        Shadow.Style.Raised;
      textures[Flavor.Bullet, FALSE, NE.Normal] := Pixmap.Empty;
      pixmaps[Flavor.Bullet, TRUE, NE.Normal] :=
        VBTKitResources.GetPixmap("radioOn");
      styles[Flavor.Bullet, TRUE, NE.Normal] :=
        Shadow.Style.Lowered;
      textures[Flavor.Bullet, TRUE, NE.Normal] := Pixmap.Solid;
      pixmaps[Flavor.Bullet, FALSE, NE.Excited] :=
        VBTKitResources.GetPixmap("radioOffExcited");
      styles[Flavor.Bullet, FALSE, NE.Excited] :=
        Shadow.Style.Raised;
      textures[Flavor.Bullet, FALSE, NE.Excited] := Pixmap.Gray;
      pixmaps[Flavor.Bullet, TRUE, NE.Excited] :=
        VBTKitResources.GetPixmap("radioOnExcited");
      styles[Flavor.Bullet, TRUE, NE.Excited] :=
        Shadow.Style.Lowered;
      textures[Flavor.Bullet, TRUE, NE.Excited] := Pixmap.Gray;
      inited[Flavor.Bullet] := TRUE;
    END
  END GetBulletResources;


(************************** BlotVBT:  ****************************)

(* When the 2-1/2d look is supported, a BlotVBT displays as a
   2-1/2d square or diamond, whose interior color and style
   (e.g., lowered or raised) can be set dynamically.  Otherwise,
   when the 2-1/2d look is not supported, a pixmap is displayed.
   The shape of VBT is the shape of the pixmap (even when 2-1/2d
   is supported), with all stretch removed. *)

TYPE
  Looks = {Same, Square, Diamond};

TYPE
  BlotVBT = PixmapVBT.T BRANDED OBJECT
        shadow  : Shadow.T;
        looks   : Looks;
        inset   : REAL;
        pm      : Pixmap.T;
        style   : Shadow.Style;
        interior: Pixmap.T
      OVERRIDES
        shape   := BlotVBTShape;
        repaint := BlotVBTRepaint;
      END;

PROCEDURE NewBlotVBT (shadow: Shadow.T := NIL;
                      looks : Looks    := Looks.Same;
                      inset : REAL     := 0.0         ): BlotVBT =
  VAR v := NEW(BlotVBT);
  BEGIN
    IF shadow = NIL THEN shadow := Shadow.None END;
    v.shadow := shadow;
    v.looks := looks;
    v.inset := inset;
    v.pm := Pixmap.Empty;
    v.style := Shadow.Style.Flat;
    v.interior := Pixmap.Empty;
    EVAL PixmapVBT.T.init(v, v.pm, v.shadow.bgFg, v.shadow.bg);
    RETURN v;
  END NewBlotVBT;

PROCEDURE BlotVBTPut (v       : BlotVBT;
                      pm      : Pixmap.T;
                      style   : Shadow.Style;
                      interior: Pixmap.T      ) =
  BEGIN
    v.pm := pm;
    v.style := style;
    v.interior := interior;
    PixmapVBT.Put(v, v.pm);
    VBT.Mark(v);
  END BlotVBTPut;

PROCEDURE BlotVBTShape (v: BlotVBT; ax: Axis.T; n: CARDINAL): VBT.SizeRange =
  VAR sr := PixmapVBT.T.shape(v, ax, n);
  BEGIN
    sr.hi := sr.lo + 1;
    RETURN sr;
  END BlotVBTShape;

PROCEDURE BlotVBTRepaint (v: BlotVBT; READONLY rgn: Region.T) =
  BEGIN
    IF (v.looks = Looks.Same) OR NOT Shadow.Supported(v.shadow, v) THEN
      PixmapVBT.T.repaint(v, rgn)
    ELSE
      BlotVBTRepaint2 (v, rgn)
    END
  END BlotVBTRepaint;
  
PROCEDURE BlotVBTRepaint2 (v: BlotVBT; READONLY clip: Region.T) =
  VAR dom, inner, outer: Rect.T; a: Rect.Partition;
  BEGIN
    dom := VBT.Domain(v);
    WITH
      dh = Pts.ToScreenPixels(v, v.inset, Axis.T.Hor),
      dv = Pts.ToScreenPixels(v, v.inset, Axis.T.Ver),
      bounds = Rect.Change(VBT.PixmapDomain(v, v.pm), dh, -dh, dv, -dv),
      delta = Point.Sub(Rect.Middle(dom), Rect.Middle(bounds)) 
    DO
      (* Now midpoint(v.pm) + delta = midpoint(dom) *)
      outer := Rect.Move(bounds, delta)
    END;
    Rect.Factor(Rect.Meet(dom, clip.r), outer, a, 0, 0);
    FOR i := 0 TO 4 DO
      IF i # 2 THEN
        VBT.PaintTexture(v, a[i], v.shadow.bg, Pixmap.Solid, Point.Origin);
      ELSE (* i = 2 *)
        WITH
          dh = Pts.ToScreenPixels(v, ABS(v.shadow.size), Axis.T.Hor),
          dv = Pts.ToScreenPixels(v, ABS(v.shadow.size), Axis.T.Ver) 
        DO
          inner := Rect.Change(outer, dh, -dh, dv, -dv)
        END;
        CASE v.looks OF
        | Looks.Same => <* ASSERT FALSE *>
        | Looks.Square =>
            ShadowPaint.Border(v, clip, v.shadow, v.style, inner, outer);
            VBT.PaintTexture(v, Rect.Meet(clip.r, inner), v.shadow.bgFg,
                             v.interior, Point.Origin);
        | Looks.Diamond =>
            ShadowPaint.Diamond(v, clip, v.shadow, v.style, inner, outer,
                                v.shadow.bgFg, v.interior);
        END
      END
    END
  END BlotVBTRepaint2;


(************************** Multi methods:  ****************************)

PROCEDURE Replace (m: MC; ch, new: VBT.T) RAISES {Multi.NotAChild} =
  BEGIN
    TRY
      IF ch = NIL THEN
        Split.AddChild (m.vbt, new)
      ELSE
        Split.Replace (m.vbt, ch, new)
      END
    EXCEPT
      Split.NotAChild => RAISE Multi.NotAChild
    END
  END Replace;

PROCEDURE Succ (m: MC; ch: VBT.T): VBT.T RAISES {Multi.NotAChild} =
  BEGIN
    IF ch = NIL THEN RETURN Split.Nth(m.vbt, 1) ELSE RETURN NIL END
  END Succ;

BEGIN
END MarginFeedbackVBT.