ui/src/split/DblBufferVBT.m3


Copyright (C) 1994, Digital Equipment Corp.
<* PRAGMA LL *>

MODULE DblBufferVBT;

IMPORT Filter, FilterClass, VBTClass, VBT, VBTRep, Point, Rect, Region,
  Trestle, TrestleComm, InstalledVBT, Batch, BatchUtil, ScrnPixmap,
  MouseSplit, DblBufferUtil;
A DblBufferVBT.T v is implemented by creating a VBT offscreen(v) that is installed off-screen. The paintbatch method is overridden to forward paint batches to offscreen(v). The operation VBT.Sync(v) updates the on-screen VBT from the portion of offscreen(v) that has changed since the last update.

Because offscreen(v) is installed off screen, the northwest corner of its domain has the coordinates (0, 0). The reshape method arranges for the double-buffer's child's domain to agree with the domain of offscreen(v). The double-buffer maintains a vector delta(v), which is the difference between the parent's and child's coordinate systems. In practice, delta(v) = Rect.Northwest(VBT.Domain(v)).

The double-buffer also maintains a rectangle badRect(v) in the child's coordinate system. The rectangle badRect(v) is a (not necessarily tightest) bounding box on the portion of offscreen(v) that has changed since the last update.

REVEAL
  T = Filter.T BRANDED OBJECT
    <* LL >= { VBT.mu.SELF, SELF } *>
    delta := Point.Origin;          (* child coord + delta = parent coord. *)
    screenId: VBT.ScreenID := -1;
    <* LL >= { SELF } *>
    offScreen: VBT.T := NIL;
    badRect, damaged: Rect.T;                   (* in child coordinates *)
  OVERRIDES
    (* split methods *)
    <* LL >= {VBT.mu, SELF, ch} *>
    beChild := BeChild;

    (* VBT down methods *)
    <* LL.sup = VBT.mu.SELF *>
    reshape := Reshape;
    repaint := Repaint;
    rescreen := Rescreen;
    <* LL.sup = VBT.mu *>
    mouse := Mouse;
    position := Position;

    (* VBT up methods *)
    <* LL.sup = ch *>
    setcage := SetCage;
    setcursor := SetCursor;
    paintbatch := PaintBatch;
    sync := Sync;
    capture := Capture;
    screenOf := ScreenOf;
  END;
Split Method Implementations --------------------------------------------

PROCEDURE BeChild(v: T; ch: VBT.T) RAISES {} =
  <* LL >= {VBT.mu, v, ch} *>
  BEGIN
    Filter.T.beChild(v, ch);
    VBTClass.ClearShortCircuit(ch)
  END BeChild;
Down Method Implementations ---------------------------------------------

In the down direction, argument points and rectangles must be translated from the parent's coordinate system to the child's coordinate system. This is accomplished by subtracting delta(prnt).

PROCEDURE Reshape(prnt: T; READONLY cd: VBT.ReshapeRec) RAISES {} =
Create and install a new off-screen VBT with prnt's width and height, set the new value delta(prnt), and recursively reshape the child so it has the same domain as offscreen(prnt).
  <* LL.sup = VBT.mu.prnt *>
  VAR child := prnt.ch; delta := Rect.NorthWest(cd.new); BEGIN
    SetupOffScreen(prnt);
    IF child # NIL THEN
      LOCK prnt DO prnt.delta := delta END;
      VBTClass.Reshape(child, Rect.Sub(cd.new, delta), Rect.Empty)
    END
  END Reshape;

PROCEDURE Repaint(prnt: T; READONLY rgn: Region.T) RAISES {} =
Merge rgn with badRect(prnt), and then update the on-screen VBT.
  <* LL.sup = VBT.mu.prnt *>
  BEGIN
    LOCK prnt DO
      prnt.badRect := Rect.Join(prnt.badRect, Rect.Sub(rgn.r, prnt.delta))
    END;
    Update(prnt)
  END Repaint;

PROCEDURE Rescreen(prnt: T; READONLY cd: VBT.RescreenRec) =
Cache the current screen-id, and then call the parent type's rescreen method.
  <* LL.sup = VBT.mu.prnt *>
  VAR screen := Trestle.ScreenOf(prnt, Point.Origin); BEGIN
    LOCK prnt DO prnt.screenId := screen.id END;
    Filter.T.rescreen(prnt, cd)
  END Rescreen;

PROCEDURE Mouse(prnt: T; READONLY cd: VBT.MouseRec) RAISES {} =
If NOT cd.cp.gone, invoke the parent type's mouse method with the mouse location translated by -delta(prnt).
  <* LL.sup = VBT.mu *>
  VAR cdP: VBT.MouseRec; child := prnt.ch; BEGIN
    IF prnt.ch # NIL THEN
      cdP := cd;
      IF NOT cd.cp.gone THEN
        cdP.cp.pt := Point.Sub(cdP.cp.pt, prnt.delta)
      END;
      VBTClass.Mouse(child, cdP)
    END
  END Mouse;

PROCEDURE Position(prnt: T; READONLY cd: VBT.PositionRec) RAISES {} =
If NOT cd.cp.offScreen, invoke the parent type's position method with the mouse location translated by -delta(prnt).
  <* LL.sup = VBT.mu *>
  VAR cdP: VBT.PositionRec; child := prnt.ch; BEGIN
    IF prnt.ch # NIL THEN
      cdP := cd;
      IF NOT cd.cp.offScreen THEN
        cdP.cp.pt := Point.Sub(cd.cp.pt, prnt.delta)
      END;
      VBTClass.Position(child, cdP)
    END
  END Position;
Up Method Implementations -----------------------------------------------

In the up direction, argument points and rectangles must be translated from the child's coordinate system to the parent's coordinate system. This is accomplished by adding delta(prnt).

PROCEDURE SetCage(prnt: T; ch: VBT.T) RAISES {} =
If the child ch's cage is non-trivial and refers to the same screen as that of its parent prnt, then translate the cage to parent coordinates and recursively propagate the message up the VBT tree.
  <* LL.sup = ch *>
  VAR cg := VBTClass.Cage(ch); BEGIN
    LOCK prnt DO
      IF cg.rect # Rect.Full AND prnt.screenId = cg.screen THEN
        cg.rect := Rect.Add(cg.rect, prnt.delta)
      END;
      VBTClass.SetCage(prnt, cg)
    END
  END SetCage;

PROCEDURE SetCursor(prnt: T; ch: VBT.T) RAISES {} =
  VAR cs := ch.getcursor();
  BEGIN (* LL=ch *)
    LOCK prnt DO
      IF cs # prnt.effectiveCursor THEN
        prnt.effectiveCursor := cs;
        IF prnt.parent # NIL THEN prnt.parent.setcursor(prnt) END
      END
    END
  END SetCursor;

PROCEDURE PaintBatch(prnt: T; <*UNUSED*> ch: VBT.T; ba: Batch.T) RAISES {} =
Merge badRect(prnt) with a bounding box of the painting commands ba; then forward the paint batch to offscreen(prnt).
  <* LL.sup = ch *>
  VAR offScreen: VBT.T; clip: Rect.T; BEGIN
    DblBufferUtil.Tighten(ba);
    clip := BatchUtil.GetClip(ba);
    LOCK prnt DO
      offScreen := prnt.offScreen;
      prnt.badRect := Rect.Join(prnt.badRect, clip);
      prnt.damaged := Rect.Join(prnt.damaged, clip)
    END;
    VBTClass.PaintBatch(offScreen, ba)
  END PaintBatch;

PROCEDURE Sync(prnt: T; <*UNUSED*> ch: VBT.T; wait: BOOLEAN) =
Update the on-screen VBT from offscreen(prnt).
  <* LL.sup = ch *>
  BEGIN
    Update(prnt, wait);
    LOCK prnt DO prnt.damaged := Rect.Empty END
  END Sync;

PROCEDURE Capture(
    prnt: T;
    <*UNUSED*> ch: VBT.T;
    READONLY rect: Rect.T;
    VAR (*OUT*) br: Region.T)
    : ScrnPixmap.T RAISES {} =
The rectangle rect is in ch's coordinate system. Capture the rectangle rect from the VBT offscreen(prnt).
  <* LL.sup = ch *>
  VAR offScreen: VBT.T; BEGIN
    LOCK prnt DO offScreen := prnt.offScreen END;
    RETURN VBT.Capture(offScreen, rect, br)
  END Capture;

PROCEDURE ScreenOf(
    prnt: T;
    <*UNUSED*> ch: VBT.T;
    READONLY pt: Point.T)
    : Trestle.ScreenOfRec RAISES {} =
The point pt is in ch's coordinate system. Recurse on prnt with the point pt translated by delta(prnt).
  <* LL.sup = ch *>
  VAR delta: Point.T; BEGIN
    LOCK prnt DO delta := prnt.delta END;
    RETURN Trestle.ScreenOf(prnt, Point.Add(pt, delta));
  END ScreenOf;

PROCEDURE ForceBatches(v: VBT.Leaf): T =
Force the paint batches of all ancestors of v up to a VBT of type T, and return that VBT.
  <* LL.sup < v *>
  BEGIN
    WHILE NOT ISTYPE(v, T) DO
      LOCK v DO VBTRep.ForceBatch(v) END;
      v := VBT.Parent(v)
    END;
    <* ASSERT v # NIL *>
    RETURN v
  END ForceBatches;

PROCEDURE GetDamaged(v: VBT.Leaf): Rect.T =
   <* LL.sup < v *>
   VAR db: T := ForceBatches(v); BEGIN
     LOCK db DO RETURN db.damaged END
   END GetDamaged;

PROCEDURE SetDamaged(v: VBT.Leaf; READONLY r: Rect.T) =
   <* LL.sup < v *>
   VAR db: T := ForceBatches(v); BEGIN
     LOCK db DO db.damaged := r END
   END SetDamaged;
Create/capture the off-screen VBT ---------------------------------------

PROCEDURE SetupOffScreen(v: T) =
Initialize v's off-screen VBT. The VBT installed offscreen is a Filter.T containing a VBT.Leaf. The field v.offScreen is set to the leaf. The offscreen VBT is created with the same width and height as v. This procedure also has the side-effect of initializing v.badRect to Rect.Full.
  <* LL.sup = VBT.mu.v *>
  VAR offScreen: VBT.T; BEGIN
    (* Delete and discard the current off-screen VBT (if any) *)
    LOCK v DO
      offScreen := v.offScreen;
      v.offScreen := NIL
    END;
    IF offScreen # NIL THEN
      Trestle.Delete(offScreen);
      VBT.Discard(offScreen)
    END;
    offScreen := NEW(VBT.Leaf);
    VAR
      dom := VBT.Domain(v);
      tso := Trestle.ScreenOf(v, Point.Origin);
      trsl := tso.trsl;
      stInstall := VBT.ScreenTypeOf(InstalledVBT.Child(v));
      st := VBT.ScreenTypeOf(v);
    <* FATAL TrestleComm.Failure *>
    BEGIN
      IF trsl # NIL AND st # NIL THEN
        (* Install a Filter above "offScreen" so that it can have a ScreenType
           that Trestle likes in the case where "v" has an "unusual" screen
           type (i.e.  there is a scale filter) *)
        WITH filter = NEW(Filter.T).init(offScreen) DO
          Trestle.Attach(filter, trsl);
          Trestle.InstallOffscreen(
            filter, dom.east - dom.west, dom.south - dom.north, stInstall);
          IF filter.st # st THEN
            (* duke it out with trestle to set the screen type and domain *)
            VBTClass.Rescreen(offScreen, st);
            VBTClass.Reshape(offScreen, filter.domain, Rect.Empty);
          END
        END
      END
    END;
    LOCK v DO
      v.offScreen := offScreen;
      v.badRect := Rect.Empty;
      v.damaged := Rect.Empty
    END
  END SetupOffScreen;

PROCEDURE Update(v: T; wait := TRUE) =
Update v from offscreen(v), and set badRect(v) to the empty rectangle.
  <* LL.sup < v *>
  VAR badRect: Rect.T; offScreen: VBT.T; delta: Point.T; BEGIN
    LOCK v DO
      badRect := v.badRect;
      offScreen := v.offScreen;
      delta := v.delta
    END;
    IF offScreen # NIL AND badRect # Rect.Empty THEN
      VAR
        dummy: Region.T;
        pixmap := VBT.Capture(offScreen, badRect, dummy);
      BEGIN
	IF pixmap # NIL THEN
	  VBT.PaintScrnPixmap(v, src := pixmap, delta := delta);
          VBT.Sync(v, wait);
          <* FATAL TrestleComm.Failure *>
	  BEGIN pixmap.free() END;
          LOCK v DO v.badRect := Rect.Empty END
	END
      END
    END
  END Update;

BEGIN
END DblBufferVBT.