(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Last modified on Sat Aug  1  1:06:10 PDT 1992 by meehan *)
(*      modified on Tue Jun 16 13:07:59 PDT 1992 by muller *)
(*      modified on Mon Jun 15 18:59:44 1992 by mhb   *)
(*      modified on Fri Mar 27 02:58:45 1992 by steveg*)


MODULE ZChildVBT;

IMPORT Axis, FilterClass, HighlightVBT, List, 
         Point, Pts, Rect, Split, SxSymbol, Text, VBT,
         VBTClass, ZSplit;

TYPE
  HotSpot = {Center, NW, NE, SW, SE};

  Coord = OBJECT END;
  AbsCoord = Coord OBJECT x, y: INTEGER;  END;
  RelCoord = Coord OBJECT x, y: REAL;  END;

  At = OBJECT END;
  ByPt = At OBJECT
           hot: HotSpot;
           pt : Coord;
         END;
  ByEdges = At OBJECT 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;
        callback := Callback;
      END;

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


PROCEDURE Init (v: T; ch: VBT.T; open: BOOLEAN := TRUE; at: List.T := NIL): T =
  BEGIN
    EVAL HighlightVBT.T.init(v, ch);
    v.open := open;
    v.at := ListToAt(at);
    v.touched := FALSE;
    RETURN v;
  END Init;

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

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)
    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 Grow(vbt: VBT.T; w, h: INTEGER) =
  BEGIN
    TYPECASE vbt OF
    | NULL => (* Nothing *)
    | T(v) => 
        v.size[Axis.T.Hor] := w;
	v.size[Axis.T.Ver] := h;
        v.sizeMM[Axis.T.Hor] := FLOAT(w) / VBT.MMToPixels(v, 1.0, Axis.T.Hor);
        v.sizeMM[Axis.T.Ver] := FLOAT(h) / VBT.MMToPixels(v, 1.0, Axis.T.Ver);
        VBT.NewShape(vbt);
    ELSE (* Nothing *)
    END;
  END Grow;

<* UNUSED *>
PROCEDURE PutAt (v: T; at: List.T) =
  BEGIN
    v.at := ListToAt(at);
    v.touched := FALSE;
  END PutAt;

<* UNUSED *>
PROCEDURE PutOpen (v: T; open: BOOLEAN) =
  BEGIN
    v.open := open;
  END PutOpen;

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) =>
        v.touched := FALSE;
        vDom := GetZRect(zDom, v);
        ZSplit.SetReshapeControl(v, ZChild);
    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;


EXCEPTION BadAtSpec;

VAR
  DefaultAt := NEW(ByPt, hot := HotSpot.Center,
                   pt := NEW(RelCoord, x := 0.5, y := 0.5));

PROCEDURE ListToAt (list: List.T): At =
  BEGIN
    TRY
      CASE List.Length(list) OF
      | 2 => RETURN NEW(ByPt, pt := GetCoord(list), hot := HotSpot.Center);
      | 3 =>
          WITH at = NEW(ByPt) DO
            at.pt := GetCoord(list);
            at.hot := GetHotSpot(list);
            RETURN at;
          END;
      | 4 =>
          WITH at = NEW(ByEdges) DO
            at.nw := GetCoord(list);
            at.se := GetCoord(list);
            (* check that both are abs or rel *)
            RETURN at;
          END;
      ELSE
        RETURN DefaultAt;
      END;
    EXCEPT
      BadAtSpec => RETURN DefaultAt
    END;
  END ListToAt;

PROCEDURE GetCoord (VAR list: List.T): Coord RAISES {BadAtSpec} =
  VAR c: Coord;
  BEGIN
    TYPECASE List.Pop(list) OF
    | REF INTEGER (ri) => c := NEW(AbsCoord, x := ri^);
    | REF REAL (rr) => c := NEW(RelCoord, x := rr^);
    ELSE
      RAISE BadAtSpec;
    END;
    TYPECASE List.Pop(list) OF
    | REF INTEGER (ri) =>
        TYPECASE (c) OF
        | AbsCoord (ac) => ac.y := ri^;
        | RelCoord (rc) => rc.y := FLOAT(ri^);
        ELSE
        END;
    | REF REAL (rr) =>
        TYPECASE (c) OF
        | AbsCoord (ac) => c := NEW(RelCoord, x := FLOAT(ac.x), y := rr^);
        | RelCoord (rc) => rc.y := rr^;
        ELSE
        END;
    ELSE
      RAISE BadAtSpec;
    END;
    RETURN c;
  END GetCoord;

PROCEDURE GetHotSpot (VAR list: List.T): HotSpot RAISES {BadAtSpec} =
  BEGIN
    TYPECASE List.Pop(list) OF
    | SxSymbol.T (sym) =>
        IF Text.Equal(sym.name, "NW") THEN
          RETURN HotSpot.NW
        ELSIF Text.Equal(sym.name, "NE") THEN
          RETURN HotSpot.NE
        ELSIF Text.Equal(sym.name, "SW") THEN
          RETURN HotSpot.SW
        ELSIF Text.Equal(sym.name, "SE") THEN
          RETURN HotSpot.SE
        ELSE
          RAISE BadAtSpec
        END
    ELSE
      RAISE BadAtSpec;
    END;
  END GetHotSpot;

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

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
      RETURN NaturalRect (newParentDomain, ch);
    END;
  END NaturalReshape;

PROCEDURE Map (pct: REAL; low, high: INTEGER): INTEGER =
  BEGIN
    RETURN low + ROUND(FLOAT(high - low) * pct);
  END Map;

PROCEDURE GetZRect (dom: Rect.T; ch: T): Rect.T =
  VAR
    p: Point.T;
    r: Rect.T;
  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 + Pts.ToScreenPixels(ch, FLOAT(ac.x), Axis.T.Hor);
              p.v := dom.north
                       + Pts.ToScreenPixels(ch, FLOAT(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 + Pts.ToScreenPixels(ch, FLOAT(ac.x), Axis.T.Hor);
              r.north := dom.north + Pts.ToScreenPixels(
                                       ch, FLOAT(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 + Pts.ToScreenPixels(ch, FLOAT(ac.x), Axis.T.Hor);
              r.south := dom.north + Pts.ToScreenPixels(
                                       ch, FLOAT(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
          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 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 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.