(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Last modified on Thu Dec 31 15:50:01 PST 1992 by msm     *)

<* PRAGMA LL *>

MODULE JoinParent;

IMPORT Axis, ETAgent, FilterClass, MouseSplit, Point, Rect, Region,
       ScrnCursor, Trestle, VBT, VBTClass, JoinedVBT, JoinScreen, VBTRep;

EXCEPTION Failure;
<* FATAL Failure *>

TYPE
  Ref = OBJECT
          <* LL >= {VBT.mu, child} *>
          child        : JoinedVBT.T;
          current      : T              := NIL;
          joinST       : JoinScreen.T;
          needsRescreen                 := TRUE;
          ignoreNextButton := FALSE;
          mouseFocus: T := NIL;
        END;

REVEAL
  T = Public BRANDED OBJECT
        cl   : Ref;
        trsl : Trestle.T      := NIL;
        oldst: VBT.ScreenType := NIL;
      OVERRIDES
        init       := Be;
        paintbatch := JoinScreen.PaintBatch;
        setcursor  := JoinScreen.SetCursor;
        discard    := Discard;
        repaint    := Repaint;
        reshape    := Reshape;
        rescreen   := Rescreen;
        misc       := Misc;
      END;

REVEAL JoinedVBT.T <: Join;

PROCEDURE Current (v: JoinedVBT.T): T =
  BEGIN
    IF v.parents = NIL OR v.parents.cl = NIL THEN RETURN NIL END;
    RETURN v.parents.cl.current
  END Current;

PROCEDURE ResetCages (v: JoinedVBT.T; prnt: T) =
  VAR
    p  := v.parents;
    cl := prnt.cl;
    cp := VBT.CursorPosition{pt := Point.Origin, screen := VBT.AllScreens,
                             gone := TRUE, offScreen := TRUE};
  BEGIN
    LOCK v DO
      cl.current := prnt;
      VBTClass.ForceEscape(v)
    END;
    IF cl.mouseFocus # NIL THEN
      VBTClass.Position(v, VBT.PositionRec{cp := cp, time := 0,
                                           modifiers := VBT.Modifiers{}});
      VBTClass.Mouse(
        v, VBT.MouseRec{whatChanged := VBT.Modifier.Mouse4, time := 0,
                        cp := cp, modifiers := VBT.Modifiers{},
                        clickType := VBT.ClickType.LastUp, clickCount := 0})
    END;
    cl.mouseFocus := NIL;
    cl.ignoreNextButton := FALSE;
    IF prnt = NIL THEN RETURN END;
    WHILE p # NIL DO
      IF p.trsl = prnt.trsl THEN VBT.SetCage(p, VBT.GoneCage) END;
      p := p.link
    END
  END ResetCages;

PROCEDURE SetInput (v: JoinedVBT.T; prnt: T) =
  VAR curParent: T := NIL; pt: T;
  BEGIN
    IF v.parent # NIL THEN curParent := v.parent.parent END;
    IF curParent = prnt THEN RETURN END;
    IF curParent # NIL AND (prnt = NIL OR curParent.trsl # prnt.trsl) THEN
      pt := v.parents;
      WHILE pt # NIL DO
        IF pt.trsl = curParent.trsl THEN
          ETAgent.ReleaseSelections(pt)
        END;
        pt := pt.link
      END;
      IF prnt # NIL THEN ResetCages(v, prnt) END
    END;
    LOCK v DO
      IF prnt = NIL THEN v.parent := NIL ELSE v.parent := prnt.ch END
    END
  END SetInput;

PROCEDURE NeedsRescreen (v: JoinedVBT.T): BOOLEAN =
  VAR p := v.parents;
  BEGIN
    IF p = NIL OR NOT p.cl.needsRescreen THEN RETURN FALSE END;
    LOCK v DO p.cl.needsRescreen := FALSE END;
    RETURN TRUE
  END NeedsRescreen;

PROCEDURE ST (v: JoinedVBT.T): VBT.ScreenType =
  VAR
    p                  := v.parents;
    st: VBT.ScreenType;
  BEGIN
    IF p = NIL THEN RETURN v.st END;
    IF UniformST(p, st) THEN
      IF st = NIL THEN st := p.cl.joinST END;
      WHILE p # NIL DO
        IF p.ch.st # p.st THEN
          VBTClass.Rescreen(p.ch, p.st);
          VBTClass.Reshape(p.ch, p.domain, Rect.Empty)
        END;
        p := p.link;
      END
    ELSE
      st := p.cl.joinST;
      p.cl.joinST.eval();
      WHILE p # NIL DO
        IF p.ch.st # st THEN
          VBTClass.Rescreen(p.ch, st);
          VBTClass.Reshape(p.ch, p.domain, Rect.Empty)
        END;
        p := p.link;
      END
    END;
    RETURN st
  END ST;

PROCEDURE UniformST (p: T; VAR st: VBT.ScreenType): BOOLEAN =
  BEGIN
    st := NIL;
    WHILE p # NIL DO
      IF p.st # st AND p.st # NIL THEN
        IF st = NIL THEN st := p.st ELSE RETURN FALSE END
      END;
      p := p.link
    END;
    RETURN TRUE
  END UniformST;

PROCEDURE Domain (v: JoinedVBT.T): Rect.T =
  VAR
    res := Rect.Empty;
    p   := v.parents;
  BEGIN
    WHILE p # NIL DO res := Rect.Join(res, p.domain); p := p.link END;
    RETURN res
  END Domain;

PROCEDURE NewRef (v: JoinedVBT.T): Ref =
  BEGIN
    RETURN NEW(Ref, child := v, joinST := JoinScreen.New())
  END NewRef;

TYPE
  ChildT = VBT.Split OBJECT
             cs: ScrnCursor.T;
             cl: Ref;
           OVERRIDES
             getcursor := GetCursor;
             succ      := ChSucc;
             setcage   := SetCage;
             setcursor := ChSetCursor;
             position  := Position;
             mouse     := Mouse;
             shape     := Shape;
           END;

PROCEDURE ChSucc (<* UNUSED *> v: ChildT; <* UNUSED *> ch: VBT.T): VBT.T =
  BEGIN
    RETURN NIL
  END ChSucc;

PROCEDURE GetCursor (v: ChildT): ScrnCursor.T =
  BEGIN
    RETURN v.cs
  END GetCursor;

PROCEDURE SetCage (v: ChildT; ch: VBT.T) =
  BEGIN
    VBT.SetCage(v, VBTClass.Cage(ch))
  END SetCage;
 
PROCEDURE ChSetCursor (v: ChildT; ch: VBT.T) =
  VAR cs := ch.getcursor();
  BEGIN
    LOCK v DO
      v.cs := cs;
      IF v.parent # NIL THEN v.parent.setcursor(v) END
    END
  END ChSetCursor;

PROCEDURE SetCursor (v: T; cs: ScrnCursor.T) =
  VAR ch: ChildT := v.ch;
  BEGIN
    LOCK ch DO ch.cs := cs; v.setcursor(ch) END
  END SetCursor;

PROCEDURE Position (v: ChildT; READONLY cd: VBT.PositionRec) =
  VAR
    cl                     := v.cl;
    ch       : JoinedVBT.T;
    par, vpar: T;
    b        : BOOLEAN;
  BEGIN
    IF cl = NIL THEN RETURN END;
    vpar := v.parent;
    b := vpar = cl.current;
    ch := cl.child;
    IF ch.parent # NIL THEN par := ch.parent.parent ELSE par := NIL END;
    IF par # NIL AND par.trsl = vpar.trsl THEN
      IF b = cd.cp.gone THEN
        LOCK ch DO
          IF b THEN
            cl.current := NIL
          ELSE
            b := TRUE;
            cl.current := vpar;
            ch.parent := v
          END
        END
      ELSIF cl.current = NIL AND vpar = par THEN
        b := TRUE
      END;
      IF b THEN VBTClass.Position(ch, cd) END
    END
  END Position;

PROCEDURE Mouse (v: ChildT; READONLY cd: VBT.MouseRec) =
  VAR
    cl               := v.cl;
    ch : JoinedVBT.T;
    par, vpar: T;
  BEGIN
    IF cl = NIL THEN RETURN END;
    vpar := v.parent;
    ch := cl.child;
    IF ch.parent # NIL THEN par := ch.parent.parent ELSE par := NIL END;
    IF cd.clickType = VBT.ClickType.FirstDown
         AND (cl.mouseFocus = NIL OR par # NIL AND par.trsl = vpar.trsl) THEN
      SetInput(ch, vpar);
      LOCK ch DO cl.current := vpar; ch.parent := v END;
      cl.mouseFocus := vpar;
      cl.ignoreNextButton := FALSE;
      VBTClass.Mouse(ch, cd)
    ELSIF par # NIL AND par.trsl = vpar.trsl THEN
      IF NOT cl.ignoreNextButton OR NOT cd.cp.gone THEN
        VBTClass.Mouse(ch, cd)
      END;
      cl.ignoreNextButton := vpar # cl.mouseFocus;
      IF NOT cl.ignoreNextButton AND cd.clickType = VBT.ClickType.LastUp THEN
        cl.mouseFocus := NIL
      END
    END
  END Mouse;

PROCEDURE Be (prntP: T; v: JoinedVBT.T): T =
  VAR
    cl  : Ref;
    mark      := FALSE;
  BEGIN
    LOCK v DO
      IF v.parents # NIL THEN cl := v.parents.cl ELSE cl := NewRef(v) END;
      prntP.link := v.parents;
      v.parents := prntP;
      prntP.cl := cl;
      prntP.oldst := prntP.st;
      EVAL ETAgent.T.init(prntP, NEW(ChildT, cl := cl));
      (* does the ClearShortCircuit, and VBT.Mark *)
      SetCursor(prntP, v.getcursor());
      IF v.parent = NIL THEN v.parent := prntP.ch END;
      IF cl.joinST.addScreen(prntP.st) THEN
        cl.needsRescreen := TRUE;
        mark := TRUE
      END
    END;
    IF v.st = NIL THEN
      LOCK v DO cl.needsRescreen := FALSE END;
      VBTClass.Rescreen(v, ST(v))
    ELSIF mark THEN
      VBTRep.Mark(v)
    END;
    RETURN prntP;
  END Be;

PROCEDURE New (v: JoinedVBT.T): T =
  BEGIN
    RETURN NEW(T).init(v);
  END New;

PROCEDURE Rem(prntP: T) =
  VAR
    cl := prntP.cl;
    pl: T;
    v: JoinedVBT.T;
  BEGIN                          (* LL = VBT.mu *)
    IF cl = NIL THEN RETURN END;
    v := cl.child;
    pl := v.parents;
    LOCK v DO
      (* delete prntP from list of parents *)
      IF pl = prntP THEN
        v.parents := pl.link;
      ELSE
        WHILE pl # NIL AND pl.link # prntP DO pl := pl.link END;
        IF pl = NIL THEN RETURN END; (* prnt not a parent of v"*)
        pl.link := prntP.link;
      END;
      IF prntP = cl.current THEN cl.current := NIL END
    END;

    prntP.cl := NIL;
    prntP.link := NIL;
    IF cl.joinST.removeScreen(prntP.oldst) THEN
      LOCK v DO cl.needsRescreen := TRUE END;
      VBT.Mark(v)
    END;
    IF v.parent = prntP.ch THEN SetInput(v, v.parents) END
  END Rem;

PROCEDURE Child (prnt: T): JoinedVBT.T =
  BEGIN
    IF prnt.cl = NIL THEN RETURN NIL ELSE RETURN prnt.cl.child END
  END Child;

PROCEDURE Succ (v: JoinedVBT.T; prntP: T): T =
  BEGIN
    LOCK v DO
      IF prntP = NIL THEN RETURN v.parents ELSE RETURN prntP.link END
    END
  END Succ;

PROCEDURE Shape (v: ChildT; axis: Axis.T; n: CARDINAL): VBT.SizeRange =
  BEGIN
    IF v.cl = NIL THEN RETURN VBT.Split.shape(v, axis, n) END;
    RETURN VBTClass.GetShape(v.cl.child, axis, n)
  END Shape;

PROCEDURE Discard (prntP: T) =
  BEGIN
    IF prntP.cl # NIL THEN Rem(prntP) END
  END Discard;
  
PROCEDURE Repaint (v: T; READONLY br: Region.T) =
  VAR
    cl              := v.cl;
    ch: JoinedVBT.T;
  BEGIN
    IF cl = NIL THEN RETURN END;
    ch := cl.child;
    IF ch.parents = v AND v.link = NIL THEN
      VBTClass.Repaint(ch, br)
    ELSIF ch.ch # NIL THEN
      LOCK ch.ch DO
        LOCK ch DO VBTClass.ForceRepaint(ch.ch, br, FALSE) END
      END;
      VBT.Mark(ch)
    END
  END Repaint;

PROCEDURE Rescreen (v: T; READONLY cd: VBT.RescreenRec) =
  VAR
    cl                  := v.cl;
    ch    : JoinedVBT.T;
    m1, m2: BOOLEAN;
    st: JoinScreen.T;
  BEGIN
    v.trsl := Trestle.ScreenOf(v, Point.Origin).trsl;
    v.oldst := cd.st;
    IF cl = NIL THEN RETURN END;
    st := cl.joinST;
    m1 := st.removeScreen(v.oldst);
    m2 := st.addScreen(cd.st);
    ch := cl.child;
    IF m1 OR m2 THEN
      IF ch.parents = v AND v.link = NIL THEN
        VBTClass.Rescreen(v.ch, cd.st);
        LOCK ch DO cl.needsRescreen := FALSE END;
        IF cd.st # NIL THEN
          VBTClass.Rescreen(ch, cd.st)
        ELSE
          VBTClass.Rescreen(ch, cl.joinST)
        END
      ELSE
        LOCK ch DO cl.needsRescreen := TRUE END;
        VBT.Mark(ch)
      END
    END
  END Rescreen;

PROCEDURE Reshape (v: T; READONLY cd: VBT.ReshapeRec) =
  VAR
    cl              := v.cl;
    ch: JoinedVBT.T;
  BEGIN
    IF cl = NIL THEN RETURN END;
    ch := cl.child;
    Public.reshape(v, cd);
    IF ch.parents = v AND v.link = NIL THEN
      VBTClass.Reshape(ch, cd.new, cd.saved)
    ELSIF ch.ch # NIL THEN
      LOCK ch.ch DO
        LOCK ch DO
          VBTClass.ForceRepaint(ch.ch, Region.Difference(
                                         Region.FromRect(cd.new),
                                         Region.FromRect(cd.saved)), FALSE)
        END
      END;
      VBT.Mark(ch)
    END
  END Reshape;

PROCEDURE Misc (v: T; READONLY cd: VBT.MiscRec) =
  VAR
    cl              := v.cl;
    ch: JoinedVBT.T;
    curParent: T := NIL;
  BEGIN
    IF cl = NIL THEN RETURN END;
    ch := cl.child;
    IF ch.parent # NIL THEN curParent := ch.parent.parent END;
    IF cd.type = VBT.Deleted OR cd.type = VBT.Disconnected THEN
      Rem(v);
      IF ch.parents # NIL THEN RETURN END
    END;
    IF cd.type = VBT.TakeSelection THEN
      IF curParent = NIL OR curParent.trsl = v.trsl THEN
        SetInput(ch, v)
      END;
      IF curParent.trsl = v.trsl THEN VBTClass.Misc(ch, cd) END
    ELSIF cd.selection = VBT.NilSel THEN
      VBTClass.Misc(ch, cd)
    ELSE
      Public.misc(v, cd)
    END
  END Misc;

BEGIN
END JoinParent.