vbtkit/src/lego/AnchorHelpVBT.m3


 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 Thu May 16 16:08:08 PDT 1996 by mhb      
      modified on Mon Sep 09 10:06:44 EDT 1995 by dagenais 
      modified on Tue Jan 31 09:42:47 PST 1995 by kalsow   
      modified on Wed Mar 18 15:46:44 PST 1992 by msm      
      modified on Tue Mar 10 19:07:02 1992 by steveg   
      modified on Mon Feb 24 13:52:20 PST 1992 by muller   
      modified on Sun Nov 10 21:30:22 PST 1991 by gnelson  
<*PRAGMA LL*>

MODULE AnchorHelpVBT;

IMPORT VBT, Filter, ZSplit, Point, Rect, Trestle, Axis,
Split, VBTClass, TrestleComm, Time, Thread;

REVEAL
  T = Public BRANDED OBJECT
    n: CARDINAL;            (* number of ZSplit to skip *)
    hfudge, vfudge: REAL;   (* where to pop the help window *)
    active: BOOLEAN;        (* help window popped *)
    in: BOOLEAN;            (* position is inside *)
  OVERRIDES
    position := Position;
    init := Be
  END;

PROCEDURE Be(
  v: T;
  ch: VBT.T;
  help: VBT.T;
  n: CARDINAL := 0;
  hfudge := 0.0;
  vfudge := 1.0): T RAISES {} =
  BEGIN
    v.help := help;
    v.n := n;
    v.hfudge := hfudge;
    v.vfudge := vfudge;
    v.active := FALSE;
    v.in := FALSE;
    EVAL Filter.T.init(v, ch);
    VBT.SetCage(v, VBT.GoneCage);
    RETURN v;
  END Be;

PROCEDURE New(
  ch: VBT.T;
  help: VBT.T;
  n: CARDINAL := 0;
  hfudge := 0.0;
  vfudge := 1.0): T RAISES {} =
  VAR res := NEW(T);
  BEGIN
    RETURN Be(res, ch, help, n, hfudge, vfudge);
  END New;
Simply calls Enter and Leave which do all the work. A simpler overridden position method may simply call Activate and Deactivate.

PROCEDURE Position(v: T; READONLY cd: VBT.PositionRec) RAISES {} =
  BEGIN
    IF cd.cp.gone THEN
      Leave(v);
      VBT.SetCage(v, VBT.GoneCage);
    ELSE
      Enter(v);
      VBT.SetCage(v, VBT.InsideCage);
    END;

    Filter.T.position(v, cd);
    (* The nested child should be entered last because the timer
       needs to keep the innermost T entered. *)

  END Position;
This section is almost verbatim from AnchorBtnVBT, it should somehow be shared.

PROCEDURE GetZSplit(v: T): ZSplit.T =
  VAR m := v.n; z := v.parent;
  BEGIN
    LOOP
      IF z = NIL THEN RETURN NIL END;
      IF ISTYPE(z, ZSplit.T) THEN
        IF m = 0 THEN RETURN z ELSE DEC(m) END;
      END;
      z := z.parent;
    END;
  END GetZSplit;
Pop up the help window and remember that it is active.

PROCEDURE Activate(v: T) =
  VAR
    pt := Point.MoveHV(Rect.SouthWest(VBT.Domain(v)),
      ROUND(VBT.MMToPixels(v, v.hfudge, Axis.T.Hor)),
      ROUND(VBT.MMToPixels(v, v.vfudge, Axis.T.Ver)));
    z := GetZSplit(v);
    dom: Rect.T;
  BEGIN
    IF v.active THEN RETURN; END;
    v.active := TRUE;

    IF v.help.st # v.st THEN VBTClass.Rescreen(v.help, v.st) END;
    IF z = NIL THEN
      (* insert help as top-level window *)
      WITH srec = Trestle.ScreenOf(v, pt) DO
        IF srec.trsl # NIL THEN
          dom := Shift(MinRect(v.help, srec.q), srec.dom);
          TRY
            Trestle.Attach(v.help, srec.trsl);
            Trestle.Overlap(v.help, srec.id, Rect.NorthWest(dom));
          EXCEPT
            TrestleComm.Failure => v.active := FALSE;
          END
        END
      END
    ELSE
      (* insert menu in z *)
      dom := Shift(MinRect(v.help, pt), VBT.Domain(z));
      ZSplit.Insert(z, v.help, dom);
    END;
  END Activate;
From AnchorBtnVBT

PROCEDURE Shift(READONLY menu, parent: Rect.T): Rect.T =
  (* Shift the menu left until it is entirely contained in parent or until its
     left edge coincides with the left edge of parent, unless it needs
     shifting to the right, in which shift until the left edge of menu is
     visible. Do the same thing vertically. *)
  VAR dh, dv: INTEGER;
  BEGIN
    dh := MAX(MIN(0, parent.east - menu.east), parent.west - menu.west);
    dv := MAX(MIN(0, parent.south - menu.south), parent.north - menu.north);
    RETURN Rect.MoveHV(menu, dh, dv);
  END Shift;

PROCEDURE MinRect(v: VBT.T; READONLY pt: Point.T): Rect.T =
  BEGIN
    RETURN
      Rect.FromCorner(pt,
        VBTClass.GetShape(v, Axis.T.Hor, 0).lo,
        VBTClass.GetShape(v, Axis.T.Ver, 0).lo)
  END MinRect;
Remove the help window and remember that it is inactive.

PROCEDURE Deactivate(v: T) =
  <* FATAL Split.NotAChild *>
  BEGIN
    IF NOT v.active THEN RETURN END;
    v.active := FALSE;

    WITH z = GetZSplit(v) DO
      IF z = NIL THEN
        Trestle.Delete(v.help)
      ELSE
        Split.Delete(z, v.help);
      END;
    END;
  END Deactivate;

PROCEDURE IsActive(v: T): BOOLEAN =
  BEGIN
    IF VBT.Parent(v) = NIL THEN RETURN FALSE END;
    RETURN v.active;
  END IsActive;

PROCEDURE Set(v: T; n: CARDINAL;
  hfudge, vfudge: REAL) =
  BEGIN
    IF IsActive(v) THEN Crash() END;
    v.n := n; v.hfudge := hfudge; v.vfudge := vfudge;
  END Set;

PROCEDURE Get(v: T; VAR n: CARDINAL; VAR hfudge, vfudge: REAL) =
  BEGIN
    n := v.n; hfudge := v.hfudge; vfudge := v.vfudge;
  END Get;
The Help timer is installed as a property of the top level VBT in the tree. It remembers how long the position has been out/in an AnchorHelpVBT.

TYPE
  HelpTimer = MUTEX OBJECT
      inHelp: INTEGER;          (* number of nested T we are in *)
      help: T;                  (* innermost T visited *)
      inHelpTime: LONGREAL;     (* entry time in T *)
      outHelpTime: LONGREAL;    (* time of exit of T *)
      inDelay: LONGREAL;        (* delay before entering help mode *)
      outDelay: LONGREAL;       (* delay before leaving help mode *)
      helpMode: BOOLEAN;        (* are we in help mode *)
      thread: Thread.T;         (* thread associated with the timer *)
    METHODS
      init(): HelpTimer := InitHelpTimer;
    END;

  HelpThread = Thread.Closure OBJECT
      timer: HelpTimer;
    OVERRIDES
      apply := ApplyTimer;
    END;

PROCEDURE InitHelpTimer(self: HelpTimer): HelpTimer =
  BEGIN
    self.inHelp := 0;
    self.help := NIL;
    self.inHelpTime := Time.Now();
    self.outHelpTime := Time.Now();
    self.inDelay := 0.8D0;
    self.outDelay := 0.4D0;
    self.helpMode := FALSE;
    self.thread := Thread.Fork(NEW(HelpThread, timer := self));
    RETURN self;
  END InitHelpTimer;

PROCEDURE ApplyTimer(self: HelpThread): REFANY =
  VAR
    timer := self.timer;
    now, delay, wait: LONGREAL;
    notify: T;
  BEGIN
    LOOP
      TRY
        LOCK timer DO
          wait := 100.0D0;
          notify := NIL;

          (* We are inside one or more T, should we enter help mode *)

          IF (timer.inHelp > 0) AND (NOT timer.helpMode) THEN
            now := Time.Now();
            delay := now - timer.inHelpTime;
            IF delay >= timer.inDelay THEN
              timer.helpMode := TRUE;
              notify := timer.help;
            ELSE
              wait := timer.inDelay - delay;
            END;

          (* We are outside any T, should we leave help mode *)

          ELSIF (timer.inHelp = 0) AND timer.helpMode THEN
            now := Time.Now();
            delay := now - timer.outHelpTime;
            IF delay >= timer.outDelay THEN
              timer.helpMode := FALSE;
            ELSE
              wait := timer.outDelay - delay;
            END;
          END;
        END;

        (* The innermost T entered before changing to help mode should
           be notified of the change by setting the cage to empty, and thus
           insuring the delivery of a position event to it and all its
           enclosing parents. *)

        IF notify # NIL THEN
          LOCK VBT.mu DO
            VBT.SetCage(notify,VBT.EmptyCage);
          END;
        END;

        Thread.AlertPause(wait);
      EXCEPT
      | Thread.Alerted =>
      END;
    END;
  END ApplyTimer;
Walk the VBT tree to the root and get the timer from its property list. If there is no timer yet, one is created. By attaching the timer to the root window, all the T within the same Trestle top window share the same timer but T in other top level windows and screens have their own timer.

PROCEDURE GetTimer(v: VBT.T): HelpTimer =
  VAR
    prop: REFANY;
  BEGIN
    WHILE v.parent # NIL DO
      v := v.parent;
    END;
    prop := VBT.GetProp(v,TYPECODE(HelpTimer));

    (* There is no timer, one is created *)

    IF prop = NIL THEN
      prop := NEW(HelpTimer).init();
      VBT.PutProp(v,prop);
    END;
    RETURN NARROW(prop,HelpTimer);
  END GetTimer;
The timer is accessed and its status updated. If the change is significant, the timer thread is alerted.

PROCEDURE Enter(v: T) =
  VAR
    timer := GetTimer(v);
    now: LONGREAL;
  BEGIN
    LOCK timer DO
      IF timer.helpMode THEN
        Activate(v);
      ELSE
        now := Time.Now();

        (* A T was just entered after being out for more than outDelay,
           the timer is started to enter help mode in inDelay. *)

        IF timer.inHelp = 0 AND
           ((now - timer.outHelpTime) > timer.outDelay) THEN
          timer.inHelpTime := now;
        END;
        Thread.Alert(timer.thread);
      END;

      (* v was just entered. The number of nested T is incremented. *)

      IF NOT v.in THEN
        v.in := TRUE;
        INC(timer.inHelp);
        timer.help := v;
      END;
    END;
  END Enter;

PROCEDURE Leave(v: T) =
  VAR
    timer := GetTimer(v);
    now := Time.Now();
  BEGIN
    LOCK timer DO

      (* the number of nested T is decremented *)

      IF v.in THEN
        v.in := FALSE;
        DEC(timer.inHelp);
      END;

      (* the time when the last nested T is left is remembered *)

      IF timer.inHelp = 0 THEN
        timer.help := NIL;
        timer.outHelpTime := now;
      END;

      Deactivate(v);

      IF timer.helpMode THEN
        Thread.Alert(timer.thread);
      END;
    END;
  END Leave;

PROCEDURE GetDelay(v: VBT.T; VAR inDelay, outDelay: LONGREAL) =
  VAR
    timer := GetTimer(v);
  BEGIN
    LOCK timer DO
      inDelay := timer.inDelay;
      outDelay := timer.outDelay;
    END;
  END GetDelay;

PROCEDURE SetDelay(v: VBT.T; inDelay, outDelay: LONGREAL) =
  VAR
    timer := GetTimer(v);
  BEGIN
    LOCK timer DO
      timer.inDelay := inDelay;
      timer.outDelay := outDelay;
    END;
  END SetDelay;

EXCEPTION FatalError;

PROCEDURE Crash () =
  <* FATAL FatalError *>
  BEGIN
    RAISE FatalError;
  END Crash;

BEGIN END AnchorHelpVBT.