(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Last modified on Sat Sep  4 00:43:04 PDT 1993 by mhb                      *)
(*      modified on Wed Mar  3 01:06:48 PST 1993 by meehan                   *)
(*      modified on Tue Jun 16 13:07:59 PDT 1992 by muller                   *)
(*      modified on Fri Mar 27 02:58:45 1992 by steveg                       *)

MODULE ZChildVBT;

IMPORT Axis, FilterClass, HighlightVBT, Point, Rect, Split, VBT, VBTClass,
       ZSplit;

TYPE
  HotSpot = Location;
  Coord = OBJECT END;
  AbsCoord = Coord BRANDED OBJECT x, y: REAL END;
  RelCoord = Coord BRANDED OBJECT x, y: REAL END;

  Scale = {Neither, Both, Horizontally, Vertically};

  At = OBJECT END;
  ByPt = At OBJECT hot: HotSpot; pt: Coord; END;
  ByEdges = At OBJECT scale: Scale; nw, se: Coord; END;


CONST
  Unset   = -1;
  UnsetMM = -1.0;

REVEAL
  T = Public BRANDED OBJECT
        open   : BOOLEAN;        (* the "Open" property *)
        at     : At;             (* the "At" property *)
        touched: BOOLEAN;        (* whether user has changed its position *)
        size               := ARRAY Axis.T OF INTEGER {Unset, Unset};
        (* the width and height set by the user *)
        sizeMM := ARRAY Axis.T OF REAL {UnsetMM, UnsetMM};
      OVERRIDES
        shape         := Shape;
        rescreen      := Rescreen;
        init          := Init;
        initFromEdges := InitFromEdges;
      END;

EXCEPTION BadPercentage;

PROCEDURE Init (z   : T;
                ch  : VBT.T;
                h, v          := 0.5;
                loc           := Location.Center;
                type          := CoordType.Scaled;
                open          := TRUE              ): T =
  <* FATAL BadPercentage *>
  BEGIN
    EVAL HighlightVBT.T.init (z, ch);
    z.open := open;
    z.touched := FALSE;
    IF type = CoordType.Absolute THEN
      z.at := NEW (ByPt, hot := loc, pt := NEW (AbsCoord, x := h, y := v))
    ELSIF Pct (h) AND Pct (v) THEN
      z.at := NEW (ByPt, hot := loc, pt := NEW (RelCoord, x := h, y := v))
    ELSE
      RAISE BadPercentage
    END;
    RETURN z
  END Init;

PROCEDURE InitFromEdges (v         : T;
                         ch        : VBT.T;
                         w, e, n, s: REAL;
                         type                := CoordType.Absolute;
                         open                := TRUE                ): T =
  <* FATAL BadPercentage *>
  BEGIN
    EVAL HighlightVBT.T.init (v, ch);
    v.open := open;
    v.touched := FALSE;
    IF type = CoordType.Absolute THEN
      v.at := NEW (ByEdges, scale := Scale.Neither, 
                   nw := NEW (AbsCoord, x := w, y := n),
                   se := NEW (AbsCoord, x := e, y := s))
    ELSIF Pct (w) AND Pct (e) AND Pct (n) AND Pct (s) THEN
      IF type = CoordType.HScaled THEN
        v.at := NEW (ByEdges, scale := Scale.Horizontally, 
                   nw := NEW (RelCoord, x := w, y := n),
                   se := NEW (RelCoord, x := e, y := s))
      ELSIF type = CoordType.VScaled THEN
        v.at := NEW (ByEdges, scale := Scale.Vertically, 
                   nw := NEW (RelCoord, x := w, y := n),
                   se := NEW (RelCoord, x := e, y := s))
      ELSE
        v.at := NEW (ByEdges, scale := Scale.Both,
                   nw := NEW (RelCoord, x := w, y := n),
                   se := NEW (RelCoord, x := e, y := s))
      END
    ELSE
      RAISE BadPercentage
    END;
    RETURN v;
  END InitFromEdges;

PROCEDURE Pct (x: REAL): BOOLEAN =
  BEGIN
    RETURN 0.00 <= x AND x <= 1.00
  END Pct;

PROCEDURE Shape (v: T; ax: Axis.T; n: CARDINAL): VBT.SizeRange =
  VAR sr := VBTClass.GetShape (v.ch, ax, n);
  BEGIN
    IF v.size [ax] # Unset THEN
(*
      sr.pref := MIN (MAX (sr.lo, v.size [ax]), sr.hi - 1)
*)
      sr.pref := v.size [ax];
      sr.lo := MIN (sr.lo, v.size[ax]);
      sr.hi := MAX (sr.hi, v.size[ax] + 1);
    END;
    RETURN sr;
  END Shape;

PROCEDURE Rescreen (v: T; READONLY cd: VBT.RescreenRec) =
  BEGIN
    IF v.sizeMM [Axis.T.Hor] # UnsetMM THEN
      v.size [Axis.T.Hor] :=
        ROUND (VBT.MMToPixels (v, v.sizeMM [Axis.T.Hor], Axis.T.Hor));
    END;
    IF v.sizeMM [Axis.T.Ver] # UnsetMM THEN
      v.size [Axis.T.Ver] :=
        ROUND (VBT.MMToPixels (v, v.sizeMM [Axis.T.Ver], Axis.T.Ver));
    END;
    HighlightVBT.T.rescreen (v, cd);
  END Rescreen;

PROCEDURE Grew (vbt: VBT.T; w, h: INTEGER) =
  BEGIN
    TYPECASE vbt OF T(v) =>
        v.touched := TRUE;
        RecordSize (v, Rect.FromSize (w, h));
    ELSE 
    END;
  END Grew;

PROCEDURE InitiallyMapped (vbt: VBT.T): BOOLEAN =
  BEGIN
    TYPECASE vbt OF T (v) => RETURN v.open ELSE RETURN TRUE END
  END InitiallyMapped;

PROCEDURE Pop (vbt: VBT.T; forcePlace: BOOLEAN := FALSE) =
  VAR
    zsplit := VBT.Parent(vbt);
    vDom   := ZSplit.GetDomain(vbt);
    zDom   := ZSplit.GetParentDomain(zsplit);
  BEGIN
    IF forcePlace OR Rect.IsEmpty(vDom) OR NOT Rect.Overlap(vDom, zDom)
      THEN
      (* it's not visible, so put it in standard place *)
      Inserted(vbt);
    END;
    ZSplit.Lift(vbt, ZSplit.Altitude.Top);
    ZSplit.Map(vbt);
  END Pop;

PROCEDURE Inserted (vbt: VBT.T) =
  VAR zDom, vDom: Rect.T;
  BEGIN
    zDom := VBT.Domain (VBT.Parent (vbt));
    TYPECASE vbt OF
    | T (v) =>
        vDom := GetZRect (zDom, v, Rect.Empty);
        ZSplit.SetReshapeControl (v, ZChild);
        v.touched := FALSE;
    ELSE
      vDom := NaturalRect (zDom, vbt);
      ZSplit.SetReshapeControl (vbt, Natural);
    END;
    ZSplit.Move (vbt, vDom);
  END Inserted;

PROCEDURE Moved (vbt: VBT.T) =
  BEGIN
    TYPECASE vbt OF T (v) => v.touched := TRUE ELSE END;
  END Moved;

VAR
  ZChild  := NEW (ZSplit.ReshapeControl, apply := ZChildReshape);
  Natural := NEW (ZSplit.ReshapeControl, apply := NaturalReshape);

PROCEDURE ZChildReshape (<* UNUSED *> self: ZSplit.ReshapeControl;
                                      ch  : VBT.T;
                         READONLY oldParentDomain: Rect.T;
                         READONLY newParentDomain: Rect.T;
                         READONLY oldChildDomain : Rect.T  ): Rect.T =
  <*FATAL Split.NotAChild*>
  VAR v: T := ch; r, chainedNW: Rect.T;
  BEGIN
    IF Split.Succ (VBT.Parent (v), v) = NIL THEN
      (* background child *)
      RETURN newParentDomain
    END;
    WITH offset = Point.Sub (Rect.NorthWest (newParentDomain),
                             Rect.NorthWest (oldParentDomain)) DO
      chainedNW := Rect.Move (oldChildDomain, offset)
    END;
    IF v.touched THEN
      (* chain the NW *)
      r := chainedNW;
    ELSE
      (* stay conformed to the "At" spec *)
      r := GetZRect (newParentDomain, v, chainedNW);
    END;
    RecordSize (v, r);
    RETURN r
  END ZChildReshape;

PROCEDURE RecordSize (v: T; READONLY r: Rect.T) =
  BEGIN
    v.size [Axis.T.Hor] := Rect.HorSize(r);
    v.size [Axis.T.Ver] := Rect.VerSize(r);
    v.sizeMM [Axis.T.Hor] :=
          FLOAT (v.size[Axis.T.Hor]) / VBT.MMToPixels (v, 1.0, Axis.T.Hor);
    v.sizeMM [Axis.T.Ver] :=
          FLOAT (v.size[Axis.T.Ver]) / VBT.MMToPixels (v, 1.0, Axis.T.Ver);
  END RecordSize;

PROCEDURE NaturalReshape (<* UNUSED *> self: ZSplit.ReshapeControl;
                                       ch  : VBT.T;
                          <* UNUSED *> READONLY oldParentDomain: Rect.T;
                                       READONLY newParentDomain: Rect.T;
                          <* UNUSED *> READONLY oldChildDomain : Rect.T  ):
  Rect.T =
  <*FATAL Split.NotAChild*>
  BEGIN
    IF Split.Succ (VBT.Parent (ch), ch) = NIL THEN
      (* background child *)
      RETURN newParentDomain
    ELSE
      WITH r = NaturalRect (newParentDomain, ch) DO
        RecordSize (ch, r);    
        RETURN r
      END
    END
  END NaturalReshape;

PROCEDURE NaturalRect (dom: Rect.T; ch: VBT.T): Rect.T =
  VAR natRect := Rect.Center (PrefRect (ch), Rect.Middle (dom));
  BEGIN
    RETURN Project (natRect, dom);
  END NaturalRect;

PROCEDURE GetZRect (dom: Rect.T; ch: T; READONLY chained: Rect.T): Rect.T =
  VAR p: Point.T; r: Rect.T; mid, delta: INTEGER;
  PROCEDURE map (pct: REAL; low, high: INTEGER): INTEGER =
    BEGIN
      RETURN low + ROUND (FLOAT (high - low) * pct);
    END map;
  PROCEDURE offset (mm: REAL; ax: Axis.T): INTEGER =
    BEGIN
      RETURN ROUND (VBT.MMToPixels (ch, mm, ax))
    END offset;
  BEGIN
    IF Rect.IsEmpty (dom) THEN
      RETURN Rect.Empty
    ELSE
      TYPECASE ch.at OF

      | ByPt (atPt) =>
          TYPECASE atPt.pt OF
          | AbsCoord (ac) =>
              p.h := dom.west + offset (ac.x, Axis.T.Hor);
              p.v := dom.north + offset (ac.y, Axis.T.Ver)
          | RelCoord (rc) =>
              p.h := map (rc.x, dom.west, dom.east);
              p.v := map (rc.y, dom.north, dom.south)
          ELSE <* ASSERT FALSE *>
          END;
          r := PlaceRect (PrefRect (ch), p, atPt.hot);
          RETURN Project (r, dom);
  
      | ByEdges (atEdges) =>

        TYPECASE atEdges.nw OF
        | AbsCoord (ac) =>
            r.west := dom.west + offset (ac.x, Axis.T.Hor);
            r.north := dom.north + offset (ac.y, Axis.T.Ver)
        | RelCoord (rc) =>
            r.west := map (rc.x, dom.west, dom.east);
            r.north := map (rc.y, dom.north, dom.south)
        ELSE <* ASSERT FALSE *>
        END;
        TYPECASE atEdges.se OF
        | AbsCoord (ac) =>
            r.east := dom.west + offset (ac.x, Axis.T.Hor);
            r.south := dom.north + offset (ac.y, Axis.T.Ver)
        | RelCoord (rc) =>
            r.east := map (rc.x, dom.west, dom.east);
            r.south := map (rc.y, dom.north, dom.south)
        ELSE <* ASSERT FALSE *>
        END; 

        IF atEdges.scale = Scale.Vertically THEN
          IF NOT Rect.IsEmpty (chained) THEN
	      mid := (r.west + r.east) DIV 2;
	      delta := Rect.HorSize(chained);
              r.west := mid - (delta DIV 2);
              r.east := mid + delta - (delta DIV 2);
          END;

        ELSIF atEdges.scale = Scale.Horizontally THEN
          IF NOT Rect.IsEmpty (chained) THEN
	      mid := (r.north + r.south) DIV 2;
	      delta := Rect.VerSize(chained);
              r.north := mid - (delta DIV 2);
              r.south := mid + delta - (delta DIV 2);
          END;

        END;
        RETURN r
      ELSE <* ASSERT FALSE *>
      END;
    END;
  END GetZRect;

PROCEDURE PlaceRect(r: Rect.T; p: Point.T; hot: HotSpot): Rect.T=
  (* Given a rectangle assumed to have its NW corner at the origin, return a
     rectangle that is placed relative to point p as specified by reference.
     That is to say, depending on reference, its center or one of its corners
     will be placed at p. *)
  VAR
    offh, offv: INTEGER;
  BEGIN
    CASE hot OF
    | HotSpot.Center =>
      RETURN Rect.Center(r, p);
    | HotSpot.NW =>
      offh := p.h;
      offv := p.v;
    | HotSpot.NE =>
      offh := p.h - Rect.HorSize(r);
      offv := p.v;
    | HotSpot.SW =>
      offh := p.h;
      offv := p.v - Rect.VerSize(r);
    | HotSpot.SE =>
      offh := p.h - Rect.HorSize(r);
      offv := p.v - Rect.VerSize(r);
    END;
    RETURN Rect.MoveHV(r, offh, offv);
  END PlaceRect;

PROCEDURE Project (r, dom: Rect.T): Rect.T =
  (* Return a rect that is congruent to r, offset to be sure that
     its northwest corner is always visible. *)
  VAR
    offset := Point.T {h := MAX (0, dom.west - r.west),
                       v := MAX (0, dom.north - r.north)};
  BEGIN
    RETURN Rect.Move (r, offset);
  END Project;

PROCEDURE PrefRect (ch: VBT.T): Rect.T =
  VAR sh := VBTClass.GetShapes (ch, FALSE);
  BEGIN
    RETURN Rect.FromSize (sh [Axis.T.Hor].pref, sh [Axis.T.Ver].pref);
  END PrefRect;


BEGIN
END ZChildVBT.
