dps/src/DisplayList.m3


Copyright (C) 1994, Digital Equipment Corp.

MODULE DisplayList;

IMPORT DPS, DPSWindow, Fmt, Err;

PROCEDURE NewBox (e: E; box: DPS.Box) =
Could just offer NewBoxToParent. This is convenient for subclassers.
 VAR p: T;
  BEGIN
  p := e.parent;
  IF p # NIL THEN p.NewBoxOfChild (e, box);
   ELSE e.box := box; (* New box of root. Needs repaint? *)
    END;
  END NewBox;

PROCEDURE NewBoxToParent (e: E; box: DPS.Box) =
 VAR p: T;
  BEGIN
  p := e.parent;
  IF p # NIL THEN p.NewBoxOfChild (e, box);
   ELSE e.box := box; (* New box of root. Needs repaint? *)
    END;
  END NewBoxToParent;

PROCEDURE NewBoxOfChild (<*UNUSED*> t: T; e: E; box: DPS.Box) =
 VAR dirt: DPS.Box;
  BEGIN
  dirt := DPS.BoxUnion (e.box, box);
  e.box := box;
  e.Dirty (dirt, NIL);
  END NewBoxOfChild;

PROCEDURE Repaint (t: T; box: DPS.Box; only: REFANY): TEXT =
 VAR him, ret: TEXT := "";
 VAR ee: E;
  BEGIN
  TYPECASE only OF
  NULL =>
    ee := t.First();
    WHILE ee # NIL DO
      him := ee.Repaint (box, only);
      IF him # NIL THEN ret := ret & him; END;
      ee := ee.Next();
      END;
  | E(eeonly) =>
    (*
    ee := t.First();
    WHILE ee # NIL DO
      him := ee.Repaint (box, NIL);
      IF him # NIL THEN ret := ret & him; END;
      ee := ee.Next();
      END;
    *)
    (*
    ret := eeonly.Repaint (box, only);
    *)
    ee := t.First();
    WHILE ee # NIL DO
      IF ee = eeonly THEN RETURN ee.Repaint (box, only); END;
      ee := ee.Next();
      END;
    (* If 'only' not child, have to traverse tree so ancestors can warp. *)
    ee := t.First();
    WHILE ee # NIL DO
      him := ee.Repaint (box, only);
      IF him # NIL THEN ret := ret & him; END;
      ee := ee.Next();
      END;
   ELSE Err.Msg ("Bad -only- in DisplayList.Repaint");
    END;
  RETURN ret;
  END Repaint;

PROCEDURE DirtyToWindow (r: R; box: DPS.Box; only: T := NIL) =
  BEGIN
  r.window.Dirty (box, only);
  END DirtyToWindow;

PROCEDURE DirtyToParent (e: E; box: DPS.Box; only: T := NIL) =
 VAR p: T;
  BEGIN
  p := e.parent;
  IF p # NIL THEN p.Dirty(box, only); END;
  END DirtyToParent;

PROCEDURE PostScriptToParent (e: E; script: TEXT) =
 VAR p: T;
  BEGIN
  p := e.parent;
  IF p # NIL THEN p.ImmediatePostScript(script); END;
  END PostScriptToParent;

PROCEDURE PostScriptToWindow (r: R; script: TEXT) =
 <*FATAL DPS.BadPostScript*>
 VAR w: DPSWindow.T;
  BEGIN
  w := r.window;
  IF w # NIL THEN w.Send(script); END;
  END PostScriptToWindow;

PROCEDURE Mouse (t: T; window: DPSWindow.T; event: DPS.MouseEvent): BOOLEAN =
 VAR e: E;
  BEGIN
  e := t.Last();
  WHILE e # NIL DO
    IF e.Mouse (window, event) THEN RETURN TRUE; END;
    e := e.Previous();
    END;
  (* Used to kill input focus if no-one accepted mouse. *)
  RETURN FALSE;
  END Mouse;

PROCEDURE CharR (r: R; window: DPSWindow.T; char: CHAR): BOOLEAN =
 VAR e: E;
  BEGIN
  e := r.childWithInputFocus;
  IF e # NIL THEN RETURN e.Char (window, char); END;
  Err.Msg ("Discarded Char: ", Fmt.Int(ORD(char)));
  RETURN FALSE;
  END CharR;

PROCEDURE CharT (r: T; window: DPSWindow.T; char: CHAR): BOOLEAN =
 VAR e: E;
  BEGIN
  e := r.childWithInputFocus;
  IF e # NIL THEN RETURN e.Char (window, char); END;
  Err.Msg ("Discarded Char: ", Fmt.Int(ORD(char)));
  RETURN FALSE;
  END CharT;

PROCEDURE Key (t: T; window: DPSWindow.T; event: DPS.KeyEvent) =
 VAR got: CHAR;
 VAR e: E;
  BEGIN
  got := DPS.CharFromKey (event.key, event.modifiers);
  IF got = '\000' THEN RETURN; END;
  e := t.Last();
  WHILE e # NIL DO
    IF e.Char (window, got) THEN RETURN; END;
    e := e.Previous();
    END;
  Err.Msg ("Ignored Keystroke = ",Fmt.Int(event.key)," = ",Fmt.Int(ORD(got)));
  END Key;

PROCEDURE GetInputFocus (t: T; e: E := NIL) =
 VAR c: E;
 VAR p: T;
  BEGIN
  IF e = NIL THEN (* Start of a call. *)
    KillAnyInputFocusDownFromHere (t);
    END;
  IF e # NIL THEN (* Recursive, internal call. *)
    c := t.childWithInputFocus;
    (*
    IF c = e THEN RETURN; END;
    IF c # NIL THEN c.LoseInputFocus (); END;
    *)
    IF (c#e) AND (c#NIL) THEN c.LoseInputFocus (); END;
    t.childWithInputFocus := e;
    END;
  p := t.parent; IF p # NIL THEN p.GetInputFocus(t); END;
  IF e = NIL THEN (* Debugging. *)
    ForceInputFocusToHere (t);
    END;
  END GetInputFocus;

PROCEDURE ForceInputFocusToHere (e: E) =
 VAR parent: E;
  BEGIN
  e.childWithInputFocus := NIL;
  WHILE e.parent # NIL DO
    parent := e.parent; parent.childWithInputFocus := e;
    e := e.parent;
   END;
  END ForceInputFocusToHere;

PROCEDURE KillAnyInputFocusDownFromHere (e: E) =
 VAR child: E;
  BEGIN
  IF e # NIL THEN
    child := e.childWithInputFocus;
    e.LoseInputFocus();
    e.childWithInputFocus := NIL; (* In case he doesn't. *)
    KillAnyInputFocusDownFromHere (child);
    END;
  END KillAnyInputFocusDownFromHere;

PROCEDURE LoseInputFocus (<*UNUSED*> t: T) =
  BEGIN
  END LoseInputFocus;

PROCEDURE KillInputFocus (t: T) =
 VAR e, ee: E;
  BEGIN
  e := t.childWithInputFocus;
  WHILE e # NIL DO
    ee := e.childWithInputFocus;
    e.LoseInputFocus(); (* Is it OK to work downward? *)
    e := ee;
    END;
  END KillInputFocus;

  BEGIN

  END DisplayList.

interface Err is in: