<* PRAGMA LL *>

MODULE DblBufferVBT;

IMPORT Filter, FilterClass, VBTClass, VBT, VBTRep, Point, Rect, Region,
  Trestle, TrestleComm, InstalledVBT, Batch, BatchUtil, ScrnPixmap,
  MouseSplit, DblBufferUtil, PaintOp, HighlightVBT;

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 maintains two rectangles screenDiff(v) and savedDiff(v) that satisfy the following invariants:

         I1: (A p: offscreen(v)(p) # screen(v)(p) => p IN screenDiff(v))
         I2: (A p: offscreen(v)(p) # savedBuff(v)(p) => p IN savedDiff(v))

If either offScreen(v) or savedBuff(v) are non-NIL, their domains are congruent to v's domain.

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, savedBuff: VBT.T := NIL;
    screenDiff, savedDiff: Rect.T;            (* both 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;

VAR showSyncRect := FALSE;

For debugging: when showSyncRect is true, a highlight rectangle is drawn to frame the rectangle that is copied when the on-screen VBT is updated from the off-screen VBT.

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

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
    LOCK prnt DO prnt.delta := delta END;
    IF Rect.Congruent(cd.new, cd.prev)
       AND NOT Rect.IsEmpty(cd.new) THEN
      VAR offScreen: VBT.T; BEGIN
        LOCK prnt DO offScreen := prnt.offScreen END;
        PaintVBTtoVBT(prnt, cd.new, offScreen, delta);
        LOCK prnt DO prnt.screenDiff := Rect.Empty END
      END
    ELSE
      ReshapeOffScreen(prnt);
      ReshapeSavedBuff(prnt);
      IF child # NIL THEN
        VBTClass.Reshape(child, Rect.Sub(cd.new, delta), Rect.Empty)
      END
    END
  END Reshape;

PROCEDURE Repaint(prnt: T; READONLY rgn: Region.T) RAISES {} =

Merge rgn with screenDiff(prnt), and then update the on-screen VBT.

  <* LL.sup = VBT.mu.prnt *>
  BEGIN
    LOCK prnt DO
      prnt.screenDiff :=
        Rect.Join(prnt.screenDiff, 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;

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 screenDiff(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.screenDiff := Rect.Join(prnt.screenDiff, clip);
      prnt.savedDiff := Rect.Join(prnt.savedDiff, 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)
  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.T): 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 ClearSaved2(v: T) =
  <* LL.sup < v *>
  VAR offScreen, savedBuff: VBT.T; BEGIN
    (* discard existing buffer (if any) *)
    LOCK v DO
      offScreen := v.offScreen;
      savedBuff := v.savedBuff
    END;
    IF savedBuff # NIL THEN
      Trestle.Delete(savedBuff);
      VBT.Discard(savedBuff)
    END;
    VAR savedDiff: Rect.T; BEGIN
      IF offScreen # NIL
        THEN savedDiff := VBT.Domain(offScreen)
        ELSE savedDiff := Rect.Full
      END;
      LOCK v DO
        v.savedBuff := NIL;
        v.savedDiff := savedDiff
      END
    END
  END ClearSaved2;

PROCEDURE ClearSaved(v: VBT.T) =
  <* LL.sup < v *>
  BEGIN
    WHILE NOT ISTYPE(v, T) DO v := VBT.Parent(v) END;
    <* ASSERT v # NIL *>
    ClearSaved2(v)
  END ClearSaved;

PROCEDURE Save(v: VBT.T) =
  <* LL.sup < v *>
  VAR
    db: T := ForceBatches(v);
    offscreen, savedBuff: VBT.T;
    savedDiff: Rect.T;
  BEGIN
    (* create a savedBuff if necessary *)
    LOCK db DO
      offscreen := db.offScreen;
      savedBuff := db.savedBuff;
      savedDiff := db.savedDiff
    END;
    IF offscreen = NIL THEN RETURN END;
    IF savedBuff = NIL THEN
      savedBuff := InstallOffscreen(db)
    END;
    PaintVBTtoVBT(savedBuff, savedDiff, offscreen);
    LOCK db DO
      db.savedBuff := savedBuff;
      db.savedDiff := Rect.Empty
    END
  END Save;

PROCEDURE Restore(v: VBT.T) =
  <* LL.sup < v *>
  VAR
    db: T := ForceBatches(v);
    offscreen, savedBuff: VBT.T;
    savedDiff: Rect.T;
  BEGIN
    (* create a savedBuff if necessary *)
    LOCK db DO
      offscreen := db.offScreen;
      savedBuff := db.savedBuff;
      savedDiff := db.savedDiff
    END;
    IF offscreen = NIL THEN RETURN END;
    IF savedBuff = NIL
      THEN VBT.PaintTint(offscreen, savedDiff, PaintOp.Bg)
      ELSE PaintVBTtoVBT(offscreen, savedDiff, savedBuff)
    END;
    LOCK db DO
      db.screenDiff := Rect.Join(db.screenDiff, savedDiff);
      db.savedDiff := Rect.Empty
    END
  END Restore;

PROCEDURE InstallOffscreen(v: T): VBT.T =

Install and return a new offscreen VBT whose domain is congruent to v's.

  VAR
    offScreen := NEW(VBT.Leaf);
    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;
    RETURN offScreen
  END InstallOffscreen;

PROCEDURE ReshapeOffScreen(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.screenDiff and v.savedDiff to the full domain of the off-screen VBT.

  <* 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 := InstallOffscreen(v);
    LOCK v DO
      v.offScreen := offScreen;
      v.screenDiff := VBT.Domain(offScreen);
      v.savedDiff := v.screenDiff
    END
  END ReshapeOffScreen;

PROCEDURE ReshapeSavedBuff(v: T) =
  VAR new, old: VBT.T; meet: Rect.T; BEGIN
    LOCK v DO old := v.savedBuff END;
    IF old = NIL THEN RETURN END;
    new := InstallOffscreen(v);
    (* copy the common areas *)
    meet := Rect.Meet(VBT.Domain(old), VBT.Domain(new));
    PaintVBTtoVBT(new, meet, old);
    (* fill the remaining area with background *)
    VAR a: Rect.Partition; BEGIN
      Rect.Factor(VBT.Domain(new), meet, (*out*) a, 0, 0);
      a[2] := a[4];
      FOR i := 0 TO 3 DO
        VBT.PaintTint(new, a[i], PaintOp.Bg)
      END
    END;
    (* discard the old buffer *)
    Trestle.Delete(old);
    VBT.Discard(old);
    LOCK v DO v.savedBuff := new END
  END ReshapeSavedBuff;

PROCEDURE PaintVBTtoVBT(to: VBT.T; clip: Rect.T;
  from: VBT.T; delta := Point.Origin; wait := TRUE) =
<* LL.sup < to *>
  VAR dummy: Region.T; pixmap: ScrnPixmap.T; BEGIN
    pixmap := VBT.Capture(from, Rect.Sub(clip, delta), (*OUT*) dummy);
    IF pixmap # NIL THEN
      IF dummy = Region.Empty THEN
        VBT.PaintScrnPixmap(to, src := pixmap, delta := delta);
        VBT.Sync(to, wait)
      END;
      <* FATAL TrestleComm.Failure *>
      BEGIN pixmap.free() END
    END
  END PaintVBTtoVBT;

PROCEDURE LogBadRectArea(<*UNUSED*> area: INTEGER) =

This procedure exists soley to log the area of the rectangle copied from the off-screen VBT to the on-screen VBT at update time.

  BEGIN END LogBadRectArea;

PROCEDURE Update(v: T; wait := TRUE) =

Update v from offscreen(v), and set screenDiff(v) to Rect.Empty.

  <* LL.sup < v *>
  VAR screenDiff: Rect.T; offScreen: VBT.T; delta: Point.T; BEGIN
    LOCK v DO
      screenDiff := v.screenDiff;
      offScreen := v.offScreen;
      delta := v.delta
    END;
    IF offScreen # NIL AND screenDiff # Rect.Empty THEN
      VAR transScreenDiff := Rect.Add(screenDiff, delta); BEGIN
        PaintVBTtoVBT(v, transScreenDiff, offScreen, delta, wait);
        IF showSyncRect THEN
          HighlightVBT.SetRect(v, transScreenDiff);
          VBT.Sync(v)
        END
      END;
      LogBadRectArea(Rect.HorSize(screenDiff) * Rect.VerSize(screenDiff));
      LOCK v DO v.screenDiff := Rect.Empty END
    END
  END Update;

BEGIN
END DblBufferVBT.