(* 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 Sat Oct  3 13:32:26 PDT 1992 by msm      *)
(*      modified on Tue Jun  9 02:19:07 1992 by steveg   *)
(*      modified on Mon Feb 24 13:58:32 PST 1992 by muller   *)
(*      modified on Mon Dec 30 18:11:51 PST 1991 by gnelson  *)

<*PRAGMA LL*>

UNSAFE MODULE VBT;

IMPORT Word, Thread, Rect, Point, Axis, Path, Trapezoid, Region, Pixmap, 
  Cursor, Font, PaintOp, ScrnPixmap, BatchRep, ScrnFont,
  Text, VBTClass, VBTRep, TextWr, CopyBytes, PaintExt,
  PaintPrivate, Pkl, TextRd, TextF, PropertyV, PathPrivate,
  TextToIntegerTable, Wr, Rd, Palette, PlttFrnds, RTParams;

PROCEDURE Parent(v: T): Split RAISES {} =
  BEGIN
    LOCK v DO RETURN v.parent END
  END Parent;

PROCEDURE Domain(v: T): Rect.T RAISES {} =
  BEGIN
    LOCK v DO RETURN v.domain END
  END Domain;

PROCEDURE ScreenTypeOf(v: T): ScreenType RAISES {} =
  BEGIN
    LOCK v DO RETURN v.st END
  END  ScreenTypeOf;

PROCEDURE MMToPixels(v: T; mm: REAL; ax: Axis.T): REAL RAISES {} =
  BEGIN
    LOCK v DO 
      IF v.st = NIL THEN 
        RETURN 0.0
      ELSE 
        RETURN mm * v.st.res[ax]
      END
    END
  END MMToPixels;

PROCEDURE SetCage(v: T; READONLY cg: Cage) RAISES {} =
  BEGIN
    LOCK v DO VBTClass.SetCage(v, cg) END
  END SetCage;

PROCEDURE Outside(READONLY cp: CursorPosition; READONLY cg: Cage): BOOLEAN
  RAISES {} =
  BEGIN
    RETURN NOT ((cp.gone IN cg.inOut) AND 
                ((cg.screen = AllScreens) OR (cg.screen = cp.screen))
                AND Rect.Member(cp.pt, cg.rect))
  END Outside;

PROCEDURE CageFromRect(READONLY r: Rect.T; 
  READONLY cp: CursorPosition): Cage =
  BEGIN
    RETURN Cage{r, InOut{cp.gone}, cp.screen}
  END CageFromRect;

PROCEDURE CageFromPosition(
  READONLY cp: CursorPosition;
  trackOutside, trackOffScreen: BOOLEAN := FALSE): Cage =
  BEGIN
    IF NOT cp.gone OR trackOutside AND NOT cp.offScreen OR trackOffScreen
    THEN
      RETURN Cage{Rect.FromPoint(cp.pt), InOut{cp.gone}, cp.screen}
    ELSIF cp.offScreen AND trackOutside THEN
      RETURN Cage{Rect.Full, InOut{FALSE,TRUE}, cp.screen}
    ELSE
      RETURN GoneCage
    END
  END CageFromPosition;

PROCEDURE SetCursor(v: T; cs: Cursor.T) RAISES {} =
  BEGIN
    LOCK v DO VBTClass.SetCursor(v, cs) END
  END SetCursor;

REVEAL Value = 
  Value_Public BRANDED OBJECT
    tc: INTEGER;
    txt: TEXT
  OVERRIDES
    toRef := ToRefDefault
  END;

PROCEDURE FromRef(v: REFANY): Value RAISES {} =
  <*FATAL Wr.Failure, Pkl.Error, Thread.Alerted *>
  VAR res := NEW(Value); wr: TextWr.T;
  BEGIN
    res.tc := TYPECODE(v);
    IF v = NIL OR res.tc = TYPECODE(TEXT) THEN
      res.txt := v
    ELSE
      wr := TextWr.New();
      Pkl.Write(v, wr);
      res.txt := TextWr.ToText(wr)
    END;
    RETURN res
  END FromRef;

PROCEDURE ToRefDefault(v: Value): REFANY RAISES {Error} =
  <*FATAL Rd.Failure, Thread.Alerted *>
  BEGIN
    IF v.txt = NIL OR v.tc = TYPECODE(TEXT) THEN RETURN v.txt END;
    TRY RETURN Pkl.Read(TextRd.New(v.txt)) EXCEPT
      Pkl.Error => RAISE Error(ErrorCode.WrongType)
    END;
  END ToRefDefault;

PROCEDURE Ready(<*UNUSED*> v: Value): BOOLEAN = BEGIN RETURN TRUE END Ready;

PROCEDURE Read(v: T; s: Selection; t: TimeStamp; tc: INTEGER := -1): Value
  RAISES {Error} =
  BEGIN
    IF s = KBFocus THEN RAISE Error(ErrorCode.Unreadable) END;
    IF tc = -1 THEN tc := TYPECODE(TEXT) END;
    WITH p = Parent(v) DO
      IF p = NIL THEN RAISE Error(ErrorCode.Uninstalled) END;
      RETURN p.readUp(v, v, s, t, tc)
    END;
  END Read;

PROCEDURE Write(
  v:   T;
  s:   Selection;
  t:   TimeStamp;
  val: Value;
  tc:  INTEGER := -1
  ) RAISES {Error} =
  BEGIN
    IF s = KBFocus THEN RAISE Error(ErrorCode.Unwritable) END;
    IF tc = -1 THEN tc := TYPECODE(TEXT) END;
    WITH p = Parent(v) DO
      IF p = NIL THEN RAISE Error(ErrorCode.Uninstalled) END;
      p.writeUp(v, v, s, t, val, tc)
    END;
  END Write;

PROCEDURE Acquire(v: T; s: Selection; t: TimeStamp) RAISES {Error} =
  BEGIN
    LOCK v DO VBTClass.Acquire(v, s, t) END
  END Acquire;

PROCEDURE Release(v: T; s: Selection) RAISES {} =
  BEGIN
    LOCK v DO VBTClass.Release(v, s) END
  END Release;
  
PROCEDURE Put(
         v:      T;
         s:      Selection;
         t:      TimeStamp;
         type:   MiscCodeType;
  READONLY detail: MiscCodeDetail
  ) RAISES {Error} =
  BEGIN
    LOCK v DO VBTClass.Put(v, s, t, type, detail) END
  END Put;
  
PROCEDURE Forge(v: T; type: MiscCodeType; READONLY detail: MiscCodeDetail)
  RAISES {Error} =
  BEGIN
    LOCK v DO VBTClass.Forge(v, type, detail) END
  END Forge;

PROCEDURE ForceRepaint(v: T; READONLY rgn: Region.T) RAISES {} =
  BEGIN
    LOCK v DO VBTClass.ForceRepaint(v, rgn) END
  END ForceRepaint;

CONST
  BigScrollArea = 100000;
    (* To prevent clients from queuing up lots of scrolling commands, we
       force the batch after any scrolling command larger than this. *)

  CoveredProps = VBTRep.AllProps - VBTRep.Props{VBTRep.Prop.Covered, 
      VBTRep.Prop.OnQ, VBTRep.Prop.ExcessBegins};

PROCEDURE Scroll (         v      : Leaf;
                  READONLY clp    : Rect.T;
                  READONLY dlta   : Point.T;
                           paintOp            := PaintOp.Copy) RAISES {} =
  VAR
    clip: Rect.T;
    p   : PaintPrivate.ScrollPtr;
  CONST
    bsize = ADRSIZE(PaintPrivate.ScrollRec);
    size  = bsize DIV ADRSIZE(Word.T);
  BEGIN
    IF Rect.HorSize(clp) * Rect.VerSize(clp) > BigScrollArea THEN
      Sync(v)
    END;
    LOOP
      LOCK v DO
        IF NOT (VBTRep.Prop.Reshaping IN v.props) THEN
          clip := Rect.Meet(clp, Rect.Move(v.domain, dlta))
        ELSE
          clip := clp
        END;
        IF v.remaining < bsize THEN
          IF v.st = NIL THEN RETURN END;
          VBTRep.NewBatch(v, size)
        END;
        VAR po := v.st.ops[paintOp.op];
        BEGIN
          IF po # NIL AND po # PlttFrnds.noOp THEN
            DEC(v.remaining, bsize);
            WITH b  = v.batch,
                 ss = b.scrollSource DO
              p := b.next;
              INC(b.next, bsize);
              p.command := PaintPrivate.PaintCommand.ScrollCom;
              p.clip := clip;
              p.op := po.id;
              p.delta := dlta;
              ss := Rect.Join(ss, Rect.Sub(clip, dlta))
            END;
            IF v.props <= CoveredProps THEN VBTRep.Enqueue(v) END;
            EXIT
          END
        END
      END;
      VAR st: ScreenType; BEGIN
        LOCK v DO st := v.st END;
        IF st # NIL THEN EVAL Palette.ResolveOp(st, paintOp) END
      END
    END
  END Scroll;

PROCEDURE PaintTint (v: Leaf; READONLY clp: Rect.T; paintOp: PaintOp.T)
  RAISES {} =
  VAR p: PaintPrivate.TintPtr;
  CONST
    bsize = ADRSIZE(PaintPrivate.TintRec);
    size  = bsize DIV ADRSIZE(Word.T);
  BEGIN
    LOOP
      LOCK v DO
        IF v.remaining < bsize THEN
          IF v.st = NIL THEN RETURN END;
          VBTRep.NewBatch(v, size)
        END;
        VAR po := v.st.ops[paintOp.op];
        BEGIN
          IF po # NIL AND po # PlttFrnds.noOp THEN
            DEC(v.remaining, bsize);
            WITH b = v.batch DO
              p := b.next;
              INC(b.next, bsize);
              p.command := PaintPrivate.PaintCommand.TintCom;
              p.clip := clp;
              p.op := po.id
            END;
            IF v.props <= CoveredProps THEN VBTRep.Enqueue(v) END;
            EXIT
          END
        END
      END;
      VAR st: ScreenType; BEGIN
        LOCK v DO st := v.st END;
        IF st # NIL THEN EVAL Palette.ResolveOp(st, paintOp) END
      END
    END
  END PaintTint;

PROCEDURE PolyTint (         v      : Leaf;
                    READONLY clp    : ARRAY OF Rect.T;
                             paintOp: PaintOp.T        ) RAISES {} =
  VAR
    pAdr, endP: ADDRESS;
    i         : CARDINAL;
  CONST
    bsize1 = ADRSIZE(PaintPrivate.TintRec);
    size1  = bsize1 DIV ADRSIZE(Word.T);
    bsize2 = ADRSIZE(PaintPrivate.CommandRec);
  BEGIN
    LOOP
      LOCK v DO
        IF v.st = NIL THEN RETURN END;
        VAR po := v.st.ops[paintOp.op];
        BEGIN
          IF po # NIL AND po # PlttFrnds.noOp THEN
            i := 0;
            WHILE i # NUMBER(clp) DO
              IF v.remaining < bsize1 THEN
                IF v.st = NIL THEN RETURN END;
                VBTRep.NewBatch(v, size1)
              END;
              DEC(v.remaining, bsize1);
              pAdr := v.batch.next;
              WITH p = LOOPHOLE(pAdr, PaintPrivate.TintPtr) DO
                p.command := PaintPrivate.PaintCommand.TintCom;
                p.clip := clp[i];
                p.op := po.id
              END;
              INC(i);
              INC(pAdr, bsize1);
              WITH nbsize = MIN(NUMBER(clp) - i, v.remaining DIV bsize2)
                              * bsize2 DO
                DEC(v.remaining, nbsize);
                endP := pAdr + nbsize
              END;
              WHILE pAdr # endP DO
                WITH comP = LOOPHOLE(pAdr, PaintPrivate.RepeatPtr) DO
                  comP.command := PaintPrivate.PaintCommand.RepeatCom;
                  comP.clip := clp[i]
                END;
                INC(i);
                INC(pAdr, bsize2)
              END;
              v.batch.next := pAdr
            END;
            IF v.props <= CoveredProps THEN VBTRep.Enqueue(v) END;
            EXIT
          END
        END
      END;
      VAR st: ScreenType;
      BEGIN
        LOCK v DO st := v.st END;
        IF st # NIL THEN EVAL Palette.ResolveOp(st, paintOp) END
      END
    END
  END PolyTint;

PROCEDURE PaintTexture (         v      : Leaf;
                        READONLY clp    : Rect.T;
                                 paintOp: PaintOp.T;
                                 src    : Pixmap.T;
                        READONLY dlta   : Point.T    ) RAISES {} =
  VAR p: PaintPrivate.TexturePtr;
  CONST
    bsize = ADRSIZE(PaintPrivate.PixmapRec);
    size  = bsize DIV ADRSIZE(Word.T);
  BEGIN
    LOOP
      LOCK v DO
        IF v.remaining < bsize THEN
          IF v.st = NIL THEN RETURN END;
          VBTRep.NewBatch(v, size)
        END;
        VAR
          pm := v.st.pixmaps[src.pm];
          po := v.st.ops[paintOp.op];
        BEGIN
          IF pm # NIL AND pm # PlttFrnds.noPixmap AND po # NIL
               AND po # PlttFrnds.noOp THEN
            DEC(v.remaining, bsize);
            WITH b = v.batch DO
              p := b.next;
              INC(b.next, bsize);
              p.command := PaintPrivate.PaintCommand.TextureCom;
              p.clip := clp;
              p.delta := dlta;
              p.pm := pm.id;
              p.op := po.id
            END;
            IF v.props <= CoveredProps THEN VBTRep.Enqueue(v) END;
            EXIT
          END
        END
      END;
      VAR st: ScreenType; BEGIN
        LOCK v DO st := v.st END;
        IF st # NIL THEN
          EVAL Palette.ResolveOp(st, paintOp);
          EVAL Palette.ResolvePixmap(st, src)
        END
      END
    END
  END PaintTexture;

PROCEDURE PolyTexture (         v      : Leaf;
                       READONLY clp    : ARRAY OF Rect.T;
                                paintOp: PaintOp.T;
                                src    : Pixmap.T;
                       READONLY dlta   : Point.T          ) RAISES {} =
  VAR
    pAdr, endP: ADDRESS;
    i         : CARDINAL;
  CONST
    bsize1 = ADRSIZE(PaintPrivate.PixmapRec);
    size1  = bsize1 DIV ADRSIZE(Word.T);
    bsize2 = ADRSIZE(PaintPrivate.CommandRec);
  BEGIN
    LOOP
      LOCK v DO
        IF v.st = NIL THEN RETURN END;
        VAR
          pm := v.st.pixmaps[src.pm];
          po := v.st.ops[paintOp.op];
        BEGIN
          IF pm # NIL AND pm # PlttFrnds.noPixmap AND po # NIL
               AND po # PlttFrnds.noOp THEN
            i := 0;
            WHILE i # NUMBER(clp) DO
              IF v.remaining < bsize1 THEN
                IF v.st = NIL THEN RETURN END;
                VBTRep.NewBatch(v, size1)
              END;
              DEC(v.remaining, bsize1);
              pAdr := v.batch.next;
              WITH p = LOOPHOLE(pAdr, PaintPrivate.TexturePtr) DO
                p.command := PaintPrivate.PaintCommand.TextureCom;
                p.clip := clp[i];
                p.delta := dlta;
                p.pm := pm.id;
                p.op := po.id
              END;
              INC(i);
              INC(pAdr, bsize1);
              WITH nbsize = MIN(NUMBER(clp) - i, v.remaining DIV bsize2)
                              * bsize2 DO
                DEC(v.remaining, nbsize);
                endP := pAdr + nbsize
              END;
              WHILE pAdr # endP DO
                WITH comP = LOOPHOLE(pAdr, PaintPrivate.RepeatPtr) DO
                  comP.command := PaintPrivate.PaintCommand.RepeatCom;
                  comP.clip := clp[i]
                END;
                INC(i);
                INC(pAdr, bsize2)
              END;
              v.batch.next := pAdr
            END;
            IF v.props <= CoveredProps THEN VBTRep.Enqueue(v) END;
            EXIT
          END
        END
      END;
      VAR st: ScreenType;
      BEGIN
        LOCK v DO st := v.st END;
        IF st # NIL THEN
          EVAL Palette.ResolveOp(st, paintOp);
          EVAL Palette.ResolvePixmap(st, src)
        END
      END
    END
  END PolyTexture;

PROCEDURE PaintRegion(v: Leaf; READONLY rgn: Region.T;
  op: PaintOp.T; src: Pixmap.T; READONLY delta: Point.T
  ) RAISES {} =
  BEGIN
    WITH list = Region.ToRects(rgn) DO
      PolyTexture(v, list^, op, src, delta)
    END
  END PaintRegion;

PROCEDURE PaintPixmap (         v      : Leaf;
                       READONLY clp    : Rect.T;
                                paintOp: PaintOp.T;
                                src    : Pixmap.T;
                       READONLY dlta   : Point.T    ) RAISES {} =
  VAR p: PaintPrivate.PixmapPtr;
  CONST
    bsize = ADRSIZE(PaintPrivate.PixmapRec);
    size  = bsize DIV ADRSIZE(Word.T);
  BEGIN
    LOOP
      LOCK v DO
        IF v.remaining < bsize THEN
          IF v.st = NIL THEN RETURN END;
          VBTRep.NewBatch(v, size)
        END;
        VAR
          pm := v.st.pixmaps[src.pm];
          po := v.st.ops[paintOp.op];
        BEGIN
          IF pm # NIL AND pm # PlttFrnds.noPixmap AND po # NIL
               AND po # PlttFrnds.noOp THEN
            DEC(v.remaining, bsize);
            WITH b = v.batch DO
              p := b.next;
              INC(b.next, bsize);
              p.command := PaintPrivate.PaintCommand.PixmapCom;
              p.clip := Rect.Meet(clp, Rect.Move(pm.bounds, dlta));
              p.pm := pm.id;
              p.delta := dlta;
              p.op := po.id
            END;
            IF v.props <= CoveredProps THEN VBTRep.Enqueue(v) END;
            EXIT
          END
        END
      END;
      VAR st: ScreenType;
      BEGIN
        LOCK v DO st := v.st END;
        IF st # NIL THEN
          EVAL Palette.ResolveOp(st, paintOp);
          EVAL Palette.ResolvePixmap(st, src)
        END
      END
    END
  END PaintPixmap;

PROCEDURE PixmapDomain (v: T; pix: Pixmap.T): Rect.T =
  BEGIN
    LOOP
      LOCK v DO
        WITH st = v.st DO
          IF st = NIL THEN RETURN Rect.Empty END;
          VAR pm := st.pixmaps[pix.pm];
          BEGIN
            IF pm # NIL AND pm # PlttFrnds.noPixmap THEN
              RETURN pm.bounds
            END
          END
        END
      END;
      VAR st: ScreenType; BEGIN
        LOCK v DO st := v.st END;
        IF st # NIL THEN EVAL Palette.ResolvePixmap(st, pix) END
      END
    END
  END PixmapDomain;

PROCEDURE PaintScrnPixmap (         v   : Leaf;
                           READONLY clp : Rect.T;
                                    op  : PaintOp.T      := PaintOp.Copy;
                                    src : ScrnPixmap.T;
                           READONLY dlta: Point.T                         ) =
  VAR p: PaintPrivate.PixmapPtr;
  CONST
    bsize = ADRSIZE(PaintPrivate.PixmapRec);
    size  = bsize DIV ADRSIZE(Word.T);
  BEGIN
    LOOP
      LOCK v DO
        IF v.remaining < bsize THEN
          IF v.st = NIL THEN RETURN END;
          VBTRep.NewBatch(v, size)
        END;
        VAR po := v.st.ops[op.op];
        BEGIN
          IF po # NIL AND po # PlttFrnds.noOp THEN
            DEC(v.remaining, bsize);
            WITH b = v.batch DO
              p := b.next;
              INC(b.next, bsize);
              p.command := PaintPrivate.PaintCommand.PixmapCom;
              p.clip := Rect.Meet(clp, Rect.Move(src.bounds, dlta));
              p.delta := dlta;
              p.pm := src.id;
              p.op := po.id
            END;
            IF v.props <= CoveredProps THEN VBTRep.Enqueue(v) END;
            EXIT
          END
        END
      END;
      VAR st: ScreenType; BEGIN
        LOCK v DO st := v.st END;
        IF st # NIL THEN EVAL Palette.ResolveOp(st, op) END
      END
    END
  END PaintScrnPixmap;

PROCEDURE PaintText(v: Leaf; READONLY clp: Rect.T; 
 READONLY rfpt: Point.T; fntP: Font.T; t: Text.T; 
 paintOp: PaintOp.T; READONLY dl := ARRAY OF Displacement {}) 
 RAISES {} =
  BEGIN
    PaintSub(v, clp, rfpt, fntP, SUBARRAY(t^, 0, LAST(t^)), paintOp, dl)
  END PaintText;
  
PROCEDURE PaintSub (         v      : Leaf;
                    READONLY clp    : Rect.T;
                    READONLY rfpt   : Point.T;
                             fntP   : Font.T;
                    READONLY t      : ARRAY OF CHAR;
                             paintOp: PaintOp.T       := PaintOp.BgFg;
                    READONLY dl := ARRAY OF Displacement{}) RAISES {} =
  VAR
    p          : PaintPrivate.TextPtr;
    size, bsize: INTEGER;
    dstAdr     : ADDRESS;
    dlsize  := ADRSIZE(Displacement) * NUMBER(dl);
    txtsize := ADRSIZE(CHAR) * NUMBER(t);
  BEGIN
    bsize := ADRSIZE(PaintPrivate.TextRec) + dlsize + txtsize;
    size := (bsize + ADRSIZE(Word.T) - 1) DIV ADRSIZE(Word.T);
    bsize := ADRSIZE(Word.T) * size;
    LOOP
      LOCK v DO
        IF v.remaining < bsize THEN
          IF v.st = NIL THEN RETURN END;
          VBTRep.NewBatch(v, size)
        END;
        VAR
          sf := v.st.fonts[fntP.fnt];
          po := v.st.ops[paintOp.op];
        BEGIN
          IF sf # NIL AND sf # PlttFrnds.noFont AND po # NIL
               AND po # PlttFrnds.noOp THEN
            DEC(v.remaining, bsize);
            WITH b  = v.batch,
                 bb = Rect.Move(ScrnFont.BoundingBoxSub(t, sf), rfpt) DO
              p := b.next;
              INC(b.next, bsize);
              p.command := PaintPrivate.PaintCommand.TextCom;
              p.clipped := NOT Rect.Subset(bb, clp);
              p.clip := Rect.Meet(bb, clp);
              p.refpt := rfpt;
              p.byteOrder := PaintPrivate.HostByteOrder;
              p.fnt := sf.id;
              p.txtsz := NUMBER(t);
              p.dlsz := NUMBER(dl);
              p.op := po.id;
              p.szOfRec := size
            END;
            dstAdr := p + ADRSIZE(p^);
            (* Copy in the displacement list: *)
            IF dlsize > 0 THEN
              CopyBytes.P(ADR(dl[0]), dstAdr, dlsize);
              dstAdr := dstAdr + dlsize;
            END;
            IF txtsize > 0 THEN
              CopyBytes.P(ADR(t[0]), dstAdr, txtsize)
            END;
            IF v.props <= CoveredProps THEN VBTRep.Enqueue(v) END;
            EXIT
          END
        END
      END;
      VAR st: ScreenType; BEGIN
        LOCK v DO st := v.st END;
        IF st # NIL THEN
          EVAL Palette.ResolveFont(st, fntP);
          EVAL Palette.ResolveOp(st, paintOp)
        END
      END
    END
  END PaintSub;

PROCEDURE BoundingBox (v: Leaf; txt: TEXT; fnt: Font.T): Rect.T =
  BEGIN
    LOOP
      LOCK v DO
        IF v.st = NIL THEN RETURN Rect.Empty END;
        VAR sf := v.st.fonts[fnt.fnt];
        BEGIN
          IF sf # NIL AND sf # PlttFrnds.noFont THEN
            RETURN ScrnFont.BoundingBox(txt, sf)
          END
        END
      END;
      VAR st: ScreenType; BEGIN
        LOCK v DO st := v.st END;
        IF st # NIL THEN EVAL Palette.ResolveFont(st, fnt) END
      END
    END
  END BoundingBox;

PROCEDURE TextWidth(v: Leaf; txt: TEXT; fnt: Font.T): INTEGER =
  BEGIN
    LOOP
      LOCK v DO
        IF v.st = NIL THEN RETURN 0 END;
        VAR sf := v.st.fonts[fnt.fnt];
        BEGIN
          IF sf # NIL AND sf # PlttFrnds.noFont THEN
            RETURN ScrnFont.TextWidth(txt, sf)
          END
        END
      END;
      VAR st: ScreenType; BEGIN
        LOCK v DO st := v.st END;
        IF st # NIL THEN EVAL Palette.ResolveFont(st, fnt) END
      END
    END
  END TextWidth;

(* PROCEDURE PaintPatch(
    v: Leaf;
    READONLY clip: Rect.T;
    hl, hr, vlo, vhi, start: INTEGER;
    READONLY deltaArray: ARRAY OF DeltaPair;
    op: PaintOp.T := PaintOp.BgFg;
    src: Pixmap.T := Pixmap.Solid;
    READONLY delta: Point.T := Point.Origin) =
  BEGIN
    RAISE FatalError
  END PaintPatch; *)
  
EXCEPTION FatalError; <*FATAL FatalError*>

PROCEDURE Fill (         v    : Leaf;
                READONLY clip : Rect.T;
                         path : Path.T;
                         wind : WindingCondition;
                         op   : PaintOp.T          := PaintOp.BgFg;
                         src  : Pixmap.T           := Pixmap.Solid;
                READONLY delta: Point.T            := Point.Origin  )
  RAISES {} =
  VAR
    p          : PaintExt.FillPtr;
    size, bsize: INTEGER;
    dstAdr     : ADDRESS;
    l                             := PathPrivate.Freeze(path);
    pathsize                      := path.next - path.start;
  BEGIN
    bsize := ADRSIZE(PaintExt.FillRec) + pathsize;
    size := bsize DIV ADRSIZE(Word.T);
    LOOP
      LOCK v DO
        IF v.remaining < bsize THEN
          IF v.st = NIL THEN RETURN END;
          VBTRep.NewBatch(v, size)
        END;
        VAR
          po := v.st.ops[op.op];
          pm := v.st.pixmaps[src.pm];
        BEGIN
          IF po # NIL AND po # PlttFrnds.noOp AND pm # NIL
               AND pm # PlttFrnds.noPixmap THEN
            DEC(v.remaining, bsize);
            WITH b = v.batch DO
              p := b.next;
              INC(b.next, bsize);
              p.ext.command := PaintPrivate.PaintCommand.ExtensionCom;
              p.ext.clip := clip;
              p.ext.op := po.id;
              p.ext.szOfRec := size;
              p.ext.delta := Point.Origin;
              p.ext.pm := pm.id;
              p.ext.fnt := 0;
              p.ext.subCommand := PaintExt.FillCommand;
              p.delta := delta;
              p.wind := wind;
              p.path.curveCount := path.curveCount
            END;
            dstAdr := p + ADRSIZE(p^);
            CopyBytes.P(path.start, dstAdr, pathsize);
            PathPrivate.Thaw(l);
            IF v.props <= CoveredProps THEN VBTRep.Enqueue(v) END;
            EXIT
          END
        END
      END;
      VAR st: ScreenType; BEGIN
        LOCK v DO st := v.st END;
        IF st # NIL THEN
          EVAL Palette.ResolvePixmap(st, src);
          EVAL Palette.ResolveOp(st, op)
        END
      END
    END
  END Fill;

PROCEDURE Stroke (         v    : Leaf;
                  READONLY clip : Rect.T;
                           path : Path.T;
                           width: CARDINAL  := 1;
                           end              := EndStyle.Round;
                           join             := JoinStyle.Round;
                           op   : PaintOp.T := PaintOp.BgFg;
                           src  : Pixmap.T  := Pixmap.Solid;
                  READONLY delta: Point.T   := Point.Origin     )
  RAISES {} =
  VAR
    p          : PaintExt.StrokePtr;
    size, bsize: INTEGER;
    dstAdr     : ADDRESS;
    l                               := PathPrivate.Freeze(path);
    pathsize                        := path.next - path.start;
  BEGIN
    LOOP
      bsize := ADRSIZE(PaintExt.StrokeRec) + pathsize;
      size := bsize DIV ADRSIZE(Word.T);
      LOCK v DO
        IF v.remaining < bsize THEN
          IF v.st = NIL THEN RETURN END;
          VBTRep.NewBatch(v, size)
        END;
        VAR
          po := v.st.ops[op.op];
          pm := v.st.pixmaps[src.pm];
        BEGIN
          IF po # NIL AND po # PlttFrnds.noOp AND pm # NIL
               AND pm # PlttFrnds.noPixmap THEN
            DEC(v.remaining, bsize);
            WITH b = v.batch DO
              p := b.next;
              INC(b.next, bsize);
              p.ext.command := PaintPrivate.PaintCommand.ExtensionCom;
              p.ext.clip := clip;
              p.ext.op := po.id;
              p.ext.szOfRec := size;
              p.ext.delta := Point.Origin;
              p.ext.pm := pm.id;
              p.ext.fnt := 0;
              p.ext.subCommand := PaintExt.StrokeCommand;
              p.delta := delta;
              p.width := width;
              p.end := end;
              p.join := join;
              p.path.curveCount := path.curveCount
            END;
            dstAdr := p + ADRSIZE(p^);
            CopyBytes.P(path.start, dstAdr, pathsize);
            PathPrivate.Thaw(l);
            IF v.props <= CoveredProps THEN VBTRep.Enqueue(v) END;
            EXIT
          END
        END
      END;
      VAR st: ScreenType; BEGIN
        LOCK v DO st := v.st END;
        IF st # NIL THEN
          EVAL Palette.ResolvePixmap(st, src);
          EVAL Palette.ResolveOp(st, op)
        END
      END
    END
  END Stroke;

PROCEDURE Line (         v     : Leaf;
                READONLY clip  : Rect.T;
                         p0, p1: Point.T;
                         width : CARDINAL  := 1;
                         end               := EndStyle.Round;
                         op    : PaintOp.T := PaintOp.BgFg;
                         src   : Pixmap.T  := Pixmap.Solid;
                READONLY delta : Point.T   := Point.Origin    ) RAISES {} =
  CONST
    bsize = ADRSIZE(PaintExt.LineRec);
    size  = bsize DIV ADRSIZE(Word.T);
  VAR p: PaintExt.LinePtr;
  BEGIN
    LOOP
      LOCK v DO
        IF v.remaining < bsize THEN
          IF v.st = NIL THEN RETURN END;
          VBTRep.NewBatch(v, size)
        END;
        VAR
          po := v.st.ops[op.op];
          pm := v.st.pixmaps[src.pm];
        BEGIN
          IF po # NIL AND po # PlttFrnds.noOp AND pm # NIL
               AND pm # PlttFrnds.noPixmap THEN
            DEC(v.remaining, bsize);
            WITH b = v.batch DO
              p := b.next;
              INC(b.next, bsize);
              p.ext.command := PaintPrivate.PaintCommand.ExtensionCom;
              p.ext.clip := clip;
              p.ext.op := po.id;
              p.ext.szOfRec := size;
              p.ext.delta := Point.Origin;
              p.ext.pm := pm.id;
              p.ext.fnt := 0;
              p.ext.subCommand := PaintExt.LineCommand;
              p.delta := delta;
              p.width := width;
              p.end := end;
              p.p := p0;
              p.q := p1
            END;
            IF v.props <= CoveredProps THEN VBTRep.Enqueue(v) END;
            EXIT
          END
        END
      END;
      VAR st: ScreenType; BEGIN
        LOCK v DO st := v.st END;
        IF st # NIL THEN
          EVAL Palette.ResolvePixmap(st, src);
          EVAL Palette.ResolveOp(st, op)
        END
      END
    END
  END Line;

PROCEDURE PaintTrapezoid (         v      : Leaf;
                          READONLY clp    : Rect.T;
                          READONLY trp    : Trapezoid.T;
                                   paintOp: PaintOp.T     := PaintOp.BgFg;
                                   src    : Pixmap.T      := Pixmap.Solid;
                          READONLY dlta   : Point.T       := Point.Origin  )
  RAISES {} =
  VAR
    p     : PaintPrivate.TrapPtr;
    pmP   : PaintPrivate.Pixmap;
    lo, hi: INTEGER;
  CONST
    bsize = ADRSIZE(PaintPrivate.TrapRec);
    size  = bsize DIV ADRSIZE(Word.T);
  BEGIN
    lo := MAX(trp.vlo, clp.north);
    hi := MIN(trp.vhi, clp.south);
    IF lo >= hi THEN
      RETURN
    ELSIF (trp.m1.n = 0) OR (trp.m2.n = 0) THEN
      RAISE FatalError
    END;
    LOOP
      LOCK v DO
        IF v.remaining < bsize THEN
          IF v.st = NIL THEN RETURN END;
          VBTRep.NewBatch(v, size)
        END;
        VAR
          po := v.st.ops[paintOp.op];
          pm := v.st.pixmaps[src.pm];
        BEGIN
          IF po # NIL AND po # PlttFrnds.noOp AND pm # NIL
               AND pm # PlttFrnds.noPixmap THEN
            DEC(v.remaining, bsize);
            pmP := pm.id;
            WITH b = v.batch DO
              p := b.next;
              INC(b.next, bsize);
              p.command := PaintPrivate.PaintCommand.TrapCom;
              p.clip.west := clp.west;
              p.clip.east := clp.east;
              p.clip.north := lo;
              p.clip.south := hi;
              p.delta := dlta;
              p.op := po.id;
              p.p1 := trp.p1;
              p.p2 := trp.p2;
              p.m1 := trp.m1;
              p.m2 := trp.m2;
              p.pm := pmP;
            END;
            IF v.props <= CoveredProps THEN VBTRep.Enqueue(v) END;
            EXIT
          END
        END
      END;
      VAR st: ScreenType; BEGIN
        LOCK v DO st := v.st END;
        IF st # NIL THEN
          EVAL Palette.ResolvePixmap(st, src);
          EVAL Palette.ResolveOp(st, paintOp)
        END
      END
    END
  END PaintTrapezoid;

PROCEDURE BeginGroup(v: Leaf; sizeHint: INTEGER := 0) =
  BEGIN
    LOCK v DO
      IF v.remaining < sizeHint OR v.batch = NIL THEN
        IF v.st = NIL THEN RETURN END;
        VBTRep.NewBatch(v, sizeHint DIV BYTESIZE(Word.T))
      END;
      INC(v.batch.excessBegins);
      v.props := v.props + VBTRep.Props{VBTRep.Prop.ExcessBegins}
    END
  END BeginGroup;

PROCEDURE EndGroup(v: Leaf) =
  BEGIN
    LOCK v DO
      IF v.batch = NIL THEN RETURN END;
      WITH ba = v.batch DO
        DEC(ba.excessBegins);
        IF ba.excessBegins < 0 THEN
          VBTRep.ForceBatch(v)
        ELSIF ba.excessBegins = 0 THEN
          v.props := v.props - VBTRep.Props{VBTRep.Prop.ExcessBegins};
          IF v.props <= CoveredProps THEN VBTRep.Enqueue(v) END
        END
      END
    END
  END EndGroup;

PROCEDURE Sync(v: Leaf) =
  BEGIN
    LOCK v DO
      IF v.batch # NIL THEN VBTRep.ForceBatch(v) END;
      WITH p = v.parent DO
        IF p # NIL THEN p.sync(v) END
      END
    END
  END Sync;

PROCEDURE Capture(
    v: T; 
    READONLY clip: Rect.T; 
    VAR (*out*) br: Region.T)
    : ScrnPixmap.T RAISES {} =
  VAR bad: Region.T; 
  BEGIN
    LOCK v DO
      bad := VBTClass.GetBadRegion(v);
      IF v.parent = NIL THEN
        br := Region.FromRect(clip); RETURN NIL
      ELSIF Rect.Subset(clip, v.domain) AND Region.IsEmpty(bad) THEN
        RETURN v.parent.capture(v, clip, br)
      ELSE
        WITH res = v.parent.capture(v, Rect.Meet(clip, v.domain), br) DO
          br := Region.Join(
                  Region.Join(br, bad),
                  Region.Difference(
                    Region.FromRect(clip), 
                    Region.FromRect(v.domain)));
          RETURN res
        END
      END
    END
  END Capture;

TYPE
  Mutex = OBJECT
            holder      : Thread.T := NIL;
            waitingForMe: Thread.T := NIL;
          END;

VAR pedantic := RTParams.IsPresent("CheckShape");

PROCEDURE NewShape (v: T) RAISES {} =
  BEGIN
    IF pedantic AND v.st # NIL
         AND LOOPHOLE(mu, Mutex).holder # Thread.Self() THEN
      RAISE FatalError
    END;
    LOCK v DO
      v.props := v.props + VBTRep.Props{VBTRep.Prop.HasNewShape};
      IF (v.parent # NIL) AND NOT (VBTRep.Prop.BlockNewShape IN v.props) THEN
        v.props := v.props + VBTRep.Props{VBTRep.Prop.BlockNewShape};
        v.parent.newShape(v)
      END
    END
  END NewShape;

PROCEDURE PutProp(v: T; ref: REFANY) RAISES {} =
  BEGIN 
    LOCK v DO PropertyV.Put(v.propset, ref) END
  END PutProp;

PROCEDURE GetProp(v: T; tc: INTEGER): REFANY RAISES {} =
  BEGIN 
    LOCK v DO RETURN PropertyV.Get(v.propset, tc) END
  END GetProp;

PROCEDURE RemProp(v: T; tc: INTEGER) RAISES {} =
  BEGIN
    LOCK v DO PropertyV.Remove(v.propset, tc) END
  END RemProp;

PROCEDURE Mark(v: T) RAISES {} =
  BEGIN 
    LOCK v DO VBTRep.Mark(v) END
  END Mark;

PROCEDURE IsMarked(v: T): BOOLEAN RAISES {} =
  BEGIN 
    LOCK v DO RETURN VBTRep.Prop.Marked IN v.props END
  END IsMarked;

PROCEDURE Unmark(v: T) RAISES {} =
  BEGIN 
    LOCK v DO v.props := v.props - VBTRep.Props{VBTRep.Prop.Marked} END
  END Unmark;

PROCEDURE Discard(v: T) RAISES {} =
  BEGIN
    v.discard()
  END Discard;

REVEAL Leaf = T BRANDED OBJECT
  OVERRIDES
    reshape := ReshapeDefault;
    repaint := RepaintDefault;
    rescreen := RescreenDefault;
    mouse := MouseDefault;
    key := KeyCodeDefault;
    position := PositionDefault;
    misc := MiscCodeDefault;
    shape := ShapeDefault;
    read := ReadDefault;
    write := WriteDefault;
    redisplay := RedisplayDefault;
    discard := DiscardDefault;
  END;

PROCEDURE MouseDefault(<*UNUSED*> v: T; <*UNUSED*> READONLY cd: MouseRec) RAISES {} =
  BEGIN END MouseDefault;

PROCEDURE PositionDefault(<*UNUSED*>v: T; <*UNUSED*> READONLY cd: PositionRec) RAISES {}
= BEGIN END PositionDefault;

PROCEDURE ReadDefault(<*UNUSED*> v: T; <*UNUSED*> s: Selection; <*UNUSED*> tc: CARDINAL): Value 
  RAISES {Error} = BEGIN RAISE Error(ErrorCode.Unreadable) END ReadDefault;

PROCEDURE WriteDefault(<*UNUSED*> v: T; <*UNUSED*> s: Selection; <*UNUSED*> val: Value; <*UNUSED*> tc: CARDINAL) 
  RAISES {Error} = BEGIN RAISE Error(ErrorCode.Unwritable) END WriteDefault;

PROCEDURE KeyCodeDefault(<*UNUSED*> v: T; <*UNUSED*> READONLY cd: KeyRec) RAISES {}
= BEGIN END KeyCodeDefault;

PROCEDURE MiscCodeDefault(<*UNUSED*> v: T; <*UNUSED*> READONLY cd: MiscRec) RAISES {}
= BEGIN END MiscCodeDefault;

PROCEDURE ReshapeDefault(v: T; <*UNUSED*> READONLY cd: ReshapeRec) RAISES {}
= BEGIN VBTClass.Repaint(v, Region.FromRect(v.domain)) END ReshapeDefault;

PROCEDURE RepaintDefault(<*UNUSED*> v: T; <*UNUSED*> READONLY rgn: Region.T) RAISES {}
= BEGIN END RepaintDefault;

PROCEDURE RescreenDefault(v: T; READONLY cdP: RescreenRec) 
  RAISES {} = 
  VAR cd: ReshapeRec; 
  BEGIN (* LL = v's share of VBT.mu *)
    NewShape(v);
    cd.new := Rect.Empty;
    cd.saved := Rect.Empty;
    cd.prev := cdP.prev;
    cd.marked := cdP.marked;
    v.reshape(cd)
  END RescreenDefault;

PROCEDURE RedisplayDefault(v: T) RAISES {} = 
  VAR cd: ReshapeRec; BEGIN
    cd.new := v.domain;
    cd.prev := v.domain;
    cd.saved := Rect.Empty;
    cd.marked := TRUE;
    v.reshape(cd) 
  END RedisplayDefault;

PROCEDURE DiscardDefault(<*UNUSED*> v: T) RAISES {}
= BEGIN END DiscardDefault;

PROCEDURE ShapeDefault(<*UNUSED*> v: T; <*UNUSED*> ax: Axis.T; <*UNUSED*> n: CARDINAL): SizeRange
RAISES {} =
  BEGIN RETURN DefaultShape END ShapeDefault;

PROCEDURE GetSelection(name: TEXT): Selection =
  BEGIN
    RETURN Selection{GetAtom(name, sel)}
  END GetSelection;

PROCEDURE GetMiscCodeType(name: TEXT): MiscCodeType =
  BEGIN
    RETURN MiscCodeType{GetAtom(name, mct)}
  END GetMiscCodeType;

PROCEDURE SelectionName(s: Selection): TEXT =
  BEGIN
    RETURN AtomName(s.sel, sel)
  END SelectionName;

PROCEDURE MiscCodeTypeName(type: MiscCodeType): TEXT =
  BEGIN
    RETURN AtomName(type.typ, mct)
  END MiscCodeTypeName;

TYPE
  TextSeq = REF ARRAY OF TEXT;
  AtomTable = RECORD cnt: CARDINAL; tbl: TextToIntegerTable.T; nm: TextSeq END;

PROCEDURE GetAtom(nm: TEXT; VAR tbl: AtomTable): CARDINAL =
  VAR res: INTEGER; BEGIN
    LOCK atomMu DO
      IF tbl.tbl.in(nm, res) THEN RETURN res END;
      res := tbl.cnt;
      INC(tbl.cnt);
      IF tbl.cnt > NUMBER(tbl.nm^) THEN Extend(tbl.nm) END;
      tbl.nm[res] := nm;
      EVAL tbl.tbl.put(nm, res);
      RETURN res
    END
  END GetAtom;

PROCEDURE AtomName(atm: CARDINAL; READONLY tbl: AtomTable): TEXT =
  BEGIN
    LOCK atomMu DO 
      IF atm >= tbl.cnt THEN RETURN NIL ELSE RETURN tbl.nm[atm] END
    END
  END AtomName;

PROCEDURE Extend(VAR seq: TextSeq) =
  VAR new: TextSeq; n := NUMBER(seq^); BEGIN
    new := NEW(TextSeq, MAX(6, 2 * n));
    SUBARRAY(new^, 0, n) := seq^;
    seq := new
  END Extend;

VAR
  atomMu := NEW(MUTEX);
  sel, mct := AtomTable{0, TextToIntegerTable.New(), NEW(TextSeq, 0)};
   
BEGIN
  mu := NEW(MUTEX);
  NilSel := GetSelection("NilSel");
  Forgery := GetSelection("Forgery");
  KBFocus := GetSelection("KBFocus");
  Target := GetSelection("Target");
  Source := GetSelection("Source");
  Deleted := GetMiscCodeType("Deleted");
  Disconnected := GetMiscCodeType("Disconnected");
  TakeSelection := GetMiscCodeType("TakeSelection");
  Lost := GetMiscCodeType("Lost");
  TrestleInternal := GetMiscCodeType("TrestleInternal");
  Moved := GetMiscCodeType("Moved");
END VBT.