(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Last modified on Tue Jun 16 13:08:43 PDT 1992 by muller     *)
(*      modified on Wed Jun 10  0:32:26 PDT 1992 by meehan     *)
(*      modified on Mon Apr 27 16:08:25 PDT 1992 by birrell    *)
(* ListVBT.m3 *)

MODULE ListVBT EXPORTS ListVBT;

IMPORT Axis, Font, HVSplit, PaintOp, Pixmap, Point, Pts, Rect, Region,
       ScrollerVBT, Split, TextureVBT, VBT;

(* *)
(* Types and such *)
(* *)

TYPE

  CellContents = RECORD
      value: REFANY;
      selected: BOOLEAN;
    END;

  Scroller = ScrollerVBT.T OBJECT
      list: T;
    OVERRIDES
      scroll := Scroll;
      autoScroll := AutoScroll;
      thumb := Thumb;
    END;
    
  Bar = TextureVBT.T OBJECT
      size: REAL := 1.0
    OVERRIDES
      shape := BarShape;
    END;

  Contents = VBT.Leaf OBJECT
      (* The VBT wherein the cells get painted. All painting and mouse
         interpretation is done by this class, including all calls of painter
         and selector methods. *)
      list: T;
      haveScreen: BOOLEAN := FALSE;
      height: INTEGER := 1; (* cached result of painter.height *)
      hasFocus: BOOLEAN := FALSE; (* while we have mouse focus *)
    METHODS
      cellForCP(cp: VBT.CursorPosition;
                VAR cage: VBT.Cage): INTEGER := CellForCP;
        (* LL.sup < list *)
        (* Returns cell number for given cursor position, or -1; if
           cp is above or below "contents", auto-scrolls; in any
           case, assigns to "cage" the minimal cage that would cause
           cellForCP to do something different. *)
      scrollContents(this: INTEGER) := ScrollContents;
        (* LL.sup = list *)
        (* Sets list.firstVisible to boundFirstVisible(this), and does
            scroll/repaints. *)
      boundFirstVisible() := BoundFirstVisible;
        (* LL.sup = list *)
        (* Sets firstVisible to a value that satisfies the firstVisible
           invariant and is as close as possible to the current firstVisible.
           Also calls updateScroller. *)
      moveCells(at: Cell; delta: INTEGER) := MoveCells;
        (* LL.sup = list *)
        (* Fixup the firstVisible invariant, and update the screen for cells
           [ MIN(at, at+delta), ... ).  The pixels at cell positions [at, ...)
           are suitable for cells [at+delta, ...).  Delta might be negative. 
           Also calls updateScroller. *)
      paintCells(at:Cell; n: INTEGER; bad: Rect.T) := PaintCells;
        (* LL.sup = list *)
        (* Repaint the cells; if at+n >= nCells, erase the blank space *)
      selectCell(this: Cell) := SelectCell;
        (* LL.sup = list *)
        (* Uses painter.select to adjust the cell's appearance on-screen. *)
    OVERRIDES
      repaint := Repaint;
      reshape := Reshape;
      rescreen := Rescreen;
      redisplay := Redisplay;
      mouse := Mouse;
      position := Position;
    END;

REVEAL

  Private = HVSplit.T BRANDED "ListVBT.Private 1.0" OBJECT
    END;

  T = Public BRANDED "ListVBT.T 1.0" OBJECT
      mu: MUTEX;                    (* protects all the fields *)
      vScroll: Scroller;            (* sub-window containg the scroll bar *)
      contents: Contents;           (* sub-window containing the cells *)
      cells: REF ARRAY OF CellContents;
      nCells: CARDINAL := 0;        (* total number of cells *)
      nSelections: CARDINAL := 0;   (* total number of selected cells *)
      firstSelected: Cell := 0;     (* first selected cell, for efficiency;
                                       valid iff nSelections > 0 *)
      firstVisible: Cell := 0;      (* first visible cell *)
        (* Invariant: firstVisible+nVisible>nCells iff nCells<nVisible *)
      nVisible: CARDINAL := 0;      (* screen space for visible cells *)
    METHODS
      getNextSelected(VAR this: Cell) := GetNextSelected;
        (* LL.sup = list;
           PRE: list.nSelections > 0 and there exists a selected cell >= this;
           sets "this" to first selected cell >= this *)
      updateScroller() := UpdateScroller;
        (* LL.sup = list; informs the scroller of current position and size *)
    OVERRIDES
      init := Init;
      setValue := SetValue;
      getValue := GetValue;
      count := Count;
      insertCells := InsertCells;
      removeCells := RemoveCells;
      selectNone := SelectNone;
      selectOnly := SelectOnly;
      select := Select;
      isSelected := IsSelected;
      getAllSelected := GetAllSelected;
      getFirstSelected := GetFirstSelected;
      scrollTo := ScrollTo;
      scrollToShow := ScrollToShow;
      redisplay := TRedisplay;
    END;

  TextPainter = TextPainterPublic BRANDED "ListVBT.TextPainter 1.0" OBJECT
      mu: MUTEX;
      eraseColor, textColor, hiliteColor, hiliteTextColor: PaintOp.T;
      font: Font.T;
      ascent, descent: INTEGER;
    OVERRIDES
      init := TextPainterInit;
      height := TextPainterHeight;
      paint := TextPainterPaint;
      select := TextPainterSelect;
      erase := TextPainterErase;
      setFont := TextPainterSetFont;
    END;

  UniSelector = Selector BRANDED "ListVBT.UniSelector 1.0" OBJECT
      list: T;
    OVERRIDES
      init := UniSelectorInit;
      insideClick := UniSelectorInsideClick;
      outsideClick := UniSelectorOutsideClick;
      insideDrag := UniSelectorInsideDrag;
      outsideDrag := UniSelectorOutsideDrag;
    END;

  MultiSelector = Selector BRANDED "ListVBT.MultiSelector 1.0" OBJECT
      list: T;
      anchor: Cell := 0;
      prev: Cell := 0;
      adding: BOOLEAN := FALSE;
    OVERRIDES
      init := MultiSelectorInit;
      insideClick := MultiSelectorInsideClick;
      outsideClick := MultiSelectorOutsideClick;
      insideDrag := MultiSelectorInsideDrag;
      outsideDrag := MultiSelectorOutsideDrag;
    END;


(* *)
(* Implementations of ListVBT methods *)
(* *)

PROCEDURE Init(list: T; colors: PaintOp.ColorQuad): T =
  VAR
    vs := TRUE;
    bar: TextureVBT.T;
  BEGIN
    EVAL HVSplit.T.init(list, Axis.T.Hor);
    list.mu := NEW(MUTEX);
    LOCK list.mu DO
      list.cells := NEW(REF ARRAY OF CellContents, 100);
      WITH hv = HVSplit.New(Axis.T.Hor) DO
        IF vs THEN
          list.vScroll := NEW(Scroller, list := list).init(Axis.T.Ver, colors);
          Split.AddChild(list, list.vScroll);
          bar := NEW(Bar, size := 1.0).init(colors.fg, Pixmap.Solid);
          Split.AddChild(list, bar);
        ELSE
          list.vScroll := NIL;
        END;
        list.contents := NEW(Contents, list := list);
        Split.AddChild(list, list.contents);
      END;
      IF list.painter = NIL THEN
        list.painter := NEW(TextPainter).init(colors.bg, colors.fg,
                                              colors.fg, colors.bg)
      END;
      IF list.selector = NIL THEN
        list.selector := NEW(UniSelector).init(list)
      END;
    END;
    RETURN list
  END Init;

PROCEDURE SetValue(list: T; this: Cell; value: REFANY) =
  (* LL.sup < list *)
  BEGIN
    LOCK list.mu DO
      IF (this >= 0) AND (this < list.nCells) THEN
        list.cells[this].value := value;
        list.contents.paintCells(this, 1, Rect.Full);
      END;
    END;
  END SetValue;

PROCEDURE GetValue(list: T; this: Cell): REFANY =
  (* LL.sup < list *)
  BEGIN
    LOCK list.mu DO
      IF this < 0 THEN
        RETURN NIL
      ELSIF this >= list.nCells THEN
        RETURN NIL
      ELSE
        RETURN list.cells[this].value
      END;
    END;
  END GetValue;

PROCEDURE Count(list: T): CARDINAL =
  (* LL.sup < list *)
  BEGIN
    LOCK list.mu DO
      RETURN list.nCells
    END;
  END Count;

PROCEDURE GetNextSelected(list: T; VAR this: Cell) =
  (* LL.sup = list;
     PRE: list.nSelections > 0 and there exists a selected cell >= this *)
  BEGIN
    LOOP
      <* ASSERT(this < list.nCells) *>
      IF list.cells^[this].selected THEN EXIT END;
      INC(this);
    END;
  END GetNextSelected;

PROCEDURE InsertCells(list: T; at: Cell; n: CARDINAL) =
  (* LL.sup < list *)
  VAR first: Cell; oldCells: REF ARRAY OF CellContents;
  BEGIN
    LOCK list.mu DO
      first := MAX(0, MIN(at, list.nCells));
      IF list.firstSelected >= first THEN INC(list.firstSelected, n) END;
      IF n + list.nCells > NUMBER(list.cells^) THEN
        oldCells := list.cells;
        list.cells := NEW(REF ARRAY OF CellContents,
            MAX(n + list.nCells,
                NUMBER(oldCells^) + NUMBER(oldCells^) DIV 2));
        SUBARRAY(list.cells^, 0, NUMBER(oldCells^)) := oldCells^;
      END;
      SUBARRAY(list.cells^, first+n, list.nCells-first) :=
          SUBARRAY(list.cells^, first, list.nCells-first);
      FOR i := first TO first + n - 1 DO
        list.cells^[i] := CellContents{ value := NIL, selected := FALSE };
      END;
      INC(list.nCells, n);
      list.contents.moveCells(first, n);
    END;
  END InsertCells;

PROCEDURE RemoveCells(list: T; at: Cell; n: CARDINAL) =
  (* LL.sup < list *)
  VAR first, this: Cell; amount: CARDINAL;
  BEGIN
    LOCK list.mu DO
      first := MAX(0, MIN(at, list.nCells));
      amount := MIN(at+n, list.nCells) - first;
      IF amount > 0 THEN
        this := first;
        WHILE (list.nSelections > 0) AND (this < first + amount) DO
          IF list.cells^[this].selected THEN
            list.cells^[this].selected := FALSE;
            DEC(list.nSelections);
          END;
          INC(this);
        END;
        (* Now list.firstSelected might be wrong, either because we just
           deselected it, or because it's beyond first+amount and must be
           relocated. *)
        IF list.nSelections > 0 THEN
          IF list.firstSelected >= first THEN
            this := list.firstSelected;
            list.getNextSelected(this);
            list.firstSelected := this - amount;
          END;
        END;
        SUBARRAY(list.cells^, first, list.nCells-(first+amount)) :=
            SUBARRAY(list.cells^, first+amount, list.nCells-(first+amount));
        DEC(list.nCells, amount);
        list.contents.moveCells(first+amount, -amount);
      END;
    END;
  END RemoveCells;

PROCEDURE SelectNone(list: T) =
  (* LL.sup < list *)
  VAR this: INTEGER;
  BEGIN
    LOCK list.mu DO
      this := list.firstSelected;
      WHILE list.nSelections > 0 DO
        list.getNextSelected(this);
        list.cells^[this].selected := FALSE;
        DEC(list.nSelections);
        list.contents.selectCell(this);
      END;
    END;
  END SelectNone;

PROCEDURE SelectOnly(list: T; this: Cell) =
  (* LL.sup < list *)
  BEGIN
    LOCK list.mu DO (* optimise the no-op case, to reduce flicker *)
      IF (this >= 0) AND (this < list.nCells) AND
         (list.nSelections = 1) AND list.cells^[this].selected THEN
        RETURN
      END;
    END;
    list.selectNone();
    list.select(this, TRUE);
  END SelectOnly;

PROCEDURE Select(list: T; this: Cell; selected: BOOLEAN) =
  (* LL.sup < list *)
  BEGIN
    LOCK list.mu DO
      IF (this >= 0) AND (this < list.nCells) THEN
        IF list.cells^[this].selected # selected THEN
          list.cells^[this].selected := selected;
          IF selected THEN
            INC(list.nSelections);
            IF (list.nSelections = 1) OR (this < list.firstSelected) THEN
              list.firstSelected := this;
            END;
          ELSE
            DEC(list.nSelections);
            IF (list.nSelections > 0) AND (this = list.firstSelected) THEN
              list.getNextSelected(list.firstSelected);
            END;
          END;
          list.contents.selectCell(this);
        END;
      END;
    END;
  END Select;

PROCEDURE IsSelected(list: T; this: Cell): BOOLEAN =
  (* LL.sup < list *)
  BEGIN
    LOCK list.mu DO
      IF this < 0 THEN
        RETURN FALSE
      ELSIF this >= list.nCells THEN
        RETURN FALSE
      ELSE
        RETURN list.cells^[this].selected
      END;
    END;
  END IsSelected;

PROCEDURE GetAllSelected(list: T): REF ARRAY OF Cell =
  (* LL.sup < list *)
  VAR sel: REF ARRAY OF Cell; this: Cell;
  BEGIN
    LOCK list.mu DO
      sel := NEW(REF ARRAY OF Cell, list.nSelections);
      this := list.firstSelected;
      FOR i := 0 TO NUMBER(sel^)-1 DO
        list.getNextSelected(this);
        sel^[i] := this;
        INC(this);
      END;
      RETURN sel
    END;
  END GetAllSelected;

PROCEDURE GetFirstSelected(list: T; VAR this: Cell): BOOLEAN =
  (* LL.sup < list *)
  BEGIN
    LOCK list.mu DO
      IF list.nSelections > 0 THEN
        this := list.firstSelected;
        <* ASSERT(list.cells^[this].selected) *>
        RETURN TRUE
      ELSE
        RETURN FALSE
      END;
    END;
  END GetFirstSelected;

PROCEDURE ScrollTo(list: T; this: Cell) =
  (* LL.sup < list *)
  BEGIN
    LOCK list.mu DO
      list.contents.scrollContents(this);
    END;
  END ScrollTo;

PROCEDURE ScrollToShow(list: T; this: Cell) =
  (* LL.sup < list *)
  BEGIN
    LOCK list.mu DO
      IF (this < list.firstVisible) OR
          (this >= list.firstVisible + list.nVisible) THEN
        list.contents.scrollContents(this - list.nVisible DIV 2);
      END;
    END;
  END ScrollToShow;

PROCEDURE TRedisplay(list: T) =
  (* LL.sup = VBT.mu *)
  BEGIN
    HVSplit.T.redisplay(list);
    list.contents.redisplay();
  END TRedisplay;

PROCEDURE UpdateScroller(list: T) =
  (* LL.sup = list *)
  BEGIN
    IF list.vScroll # NIL THEN
      ScrollerVBT.Update(list.vScroll, list.firstVisible,
                         MIN(list.firstVisible+list.nVisible, list.nCells),
                         list.nCells);
    END;
  END UpdateScroller;


(* *)
(* Implementations of Contents methods *)
(* *)

PROCEDURE Mouse(contents: Contents; READONLY cd: VBT.MouseRec) =
  (* LL.sup = VBT.mu *)
  VAR
    this: INTEGER; cage: VBT.Cage;
  BEGIN
    IF (cd.clickType = VBT.ClickType.FirstDown) OR contents.hasFocus THEN
      this := contents.cellForCP(cd.cp, cage);
      IF cd.clickType = VBT.ClickType.LastUp THEN
        VBT.SetCage(contents, VBT.EverywhereCage);
        contents.hasFocus := FALSE;
      ELSE
        VBT.SetCage(contents, cage);
        contents.hasFocus := TRUE;
      END;
      IF this >= 0 THEN
        contents.list.selector.insideClick(cd, this);
      ELSE
        contents.list.selector.outsideClick(cd);
      END;
    END;
  END Mouse;

PROCEDURE Position(contents: Contents; READONLY cd: VBT.PositionRec) =
  (* LL.sup = VBT.mu *)
  VAR
    this: INTEGER; cage: VBT.Cage;
  BEGIN
    IF contents.hasFocus THEN
      this := contents.cellForCP(cd.cp, cage);
      VBT.SetCage(contents, cage);
      IF this >= 0 THEN
        contents.list.selector.insideDrag(cd, this);
      ELSE
        contents.list.selector.outsideDrag(cd);
      END;
    END;
  END Position;

PROCEDURE Redisplay(contents: Contents) =
  (* LL.sup = mu *)
  BEGIN
    WITH list = contents.list DO
      LOCK list.mu DO
        IF contents.haveScreen THEN
          contents.height := list.painter.height(contents)
        ELSE
          contents.height := 1;
        END;
      END;
    END;
    VBT.Leaf.redisplay(contents);
  END Redisplay;

PROCEDURE Reshape(contents: Contents; READONLY cd: VBT.ReshapeRec) =
  (* LL.sup = mu.contents *)
  VAR
    wasNormalized: BOOLEAN;
    needsRepaint: Rect.T;
    delta: Point.T;
    oldFirstVisible: Cell;
    firstVisibleDelta: INTEGER;
  BEGIN
    WITH list = contents.list DO
      LOCK list.mu DO
        IF cd.new = Rect.Empty THEN
          list.nVisible := 0;
          firstVisibleDelta := 0;
        ELSE
          wasNormalized := (list.nSelections>0) AND
              (list.firstSelected >= list.firstVisible) AND
              (list.firstSelected < list.firstVisible+list.nVisible);
          list.nVisible := Rect.VerSize(cd.new) DIV contents.height;
          IF wasNormalized AND
              (list.firstSelected >= list.firstVisible+list.nVisible) THEN
            list.firstVisible := list.firstSelected - list.nVisible DIV 2;
          END;
          (* in any case, fix up the firstVisible invariant *)
          oldFirstVisible := list.firstVisible;
          contents.boundFirstVisible();
          firstVisibleDelta :=
              (oldFirstVisible - list.firstVisible) * contents.height;
        END;
      END;
    END;
    (* Salvage old pixels; but RWT's whiteboard says salvage never succeeds. *)
    IF (cd.saved.west <= cd.prev.west) AND
        (cd.saved.east >= cd.prev.east) AND
        (Rect.HorSize(cd.prev) >= Rect.HorSize(cd.new)) THEN
      (* If we don't have full width, we'll repaint the cells anyway *)
      delta := Point.Sub(Rect.NorthWest(cd.new), Rect.NorthWest(cd.prev));
      INC(delta.v, firstVisibleDelta);
      IF delta # Point.Origin THEN
        VBT.Scroll(contents, cd.new, delta);
      END;
      needsRepaint := cd.new;
      needsRepaint.south := needsRepaint.north +
          (cd.saved.north - cd.prev.north) + firstVisibleDelta;
      IF needsRepaint.south > needsRepaint.north THEN
        contents.repaint(Region.FromRect(needsRepaint));
      END;
      needsRepaint := cd.new;
      INC(needsRepaint.north,
          cd.saved.south - cd.prev.north + firstVisibleDelta);
      IF needsRepaint.south > needsRepaint.north THEN
        contents.repaint(Region.FromRect(needsRepaint));
      END;
    ELSE
      contents.repaint(Region.FromRect(cd.new));
    END;
  END Reshape;

PROCEDURE Rescreen(contents: Contents; READONLY cd: VBT.RescreenRec) =
  (* LL.sup = mu.contents *)
  BEGIN
    WITH list = contents.list DO
      LOCK list.mu DO
        IF cd.st = NIL THEN
          contents.haveScreen := FALSE;
          contents.height := 1;
          list.nVisible := 0;
        ELSE
          contents.haveScreen := TRUE;
          contents.height := list.painter.height(contents);
        END;
      END;
    END;
  END Rescreen;

PROCEDURE Repaint(contents: Contents; READONLY rgn: Region.T) =
  (* LL.sup = mu.contents *)
  VAR
    domain := VBT.Domain(contents);
    firstHit, lastHit: Cell;
  BEGIN
    WITH list = contents.list DO
      LOCK contents.list.mu DO
        IF rgn.r.north < domain.north THEN
          firstHit := list.firstVisible
        ELSE
          firstHit := (rgn.r.north-domain.north) DIV contents.height +
                       list.firstVisible;
        END;
        IF rgn.r.south > domain.south THEN
          lastHit := list.firstVisible + list.nVisible
        ELSE
          lastHit := (rgn.r.south-domain.north-1) DIV contents.height +
                     list.firstVisible;
        END;
        contents.paintCells(firstHit, lastHit-firstHit+1, rgn.r);
      END;
    END;
  END Repaint;

PROCEDURE CellForCP(contents: Contents; cp: VBT.CursorPosition;
                    VAR cage: VBT.Cage): INTEGER =
  (* LL.sup < list *)
  VAR
    domain := VBT.Domain(contents);
    cellInDomain: INTEGER; (* cell number relative to list.firstVisible *)
    r := domain;
  BEGIN
    WITH list = contents.list DO
      LOCK list.mu DO
        IF cp.gone THEN
          cage := VBT.EmptyCage;
          IF NOT cp.offScreen THEN
            IF cp.pt.v < domain.north THEN
              contents.scrollContents(list.firstVisible-1);
              IF list.nCells > 0 THEN
                RETURN list.firstVisible
              END;
            ELSIF cp.pt.v >= domain.south THEN
              contents.scrollContents(list.firstVisible+1);
              IF list.nCells > 0 THEN
                RETURN MIN(list.nCells, list.firstVisible + list.nVisible)-1
              END;
            END;
          END;
          RETURN -1
        ELSE
          <* ASSERT(cp.pt.v >= domain.north) *>
          cellInDomain := (cp.pt.v - domain.north) DIV contents.height;
          r.north := domain.north + cellInDomain * contents.height;
          r.south := MIN(r.north + contents.height, domain.south);
          cage := VBT.Cage{ r, VBT.InOut{FALSE}, VBT.AllScreens };
          IF list.firstVisible + cellInDomain >= list.nCells THEN
            RETURN -1
          ELSE
            RETURN list.firstVisible + cellInDomain;
          END;
        END;
      END;
    END;
  END CellForCP;

PROCEDURE ScrollContents(contents: Contents; this: INTEGER) =
  (* LL.sup = list *)
  VAR delta: INTEGER;
  BEGIN
    WITH list = contents.list DO
      delta := list.firstVisible - this;
      list.firstVisible := this;
      contents.moveCells(this, delta);
    END;
  END ScrollContents;

PROCEDURE BoundFirstVisible(contents: Contents) =
  (* LL.sup = list *)
  BEGIN
    WITH list = contents.list DO
      list.firstVisible :=
          MAX(0, MIN(list.firstVisible, list.nCells-list.nVisible) );
      list.updateScroller();
    END;
  END BoundFirstVisible;

PROCEDURE MoveCells(contents: Contents; at: Cell; delta: INTEGER) =
  (* LL.sup = list *)
        (* Fixup the firstVisible invariant, and update the screen for cells
           [ MIN(at, at+delta), ... ).  The pixels at cell positions [at, ...)
           are suitable for cells [at+delta, ...).  Delta might be negative. 
           Also calls updateScroller. *)
  VAR
    oldFirst, adjustment, boundedFirst, boundedDelta: INTEGER;
    boundedAt: Cell;
    domain := VBT.Domain(contents);
    clip: Rect.T;
  BEGIN
    WITH list = contents.list DO
      oldFirst := list.firstVisible;
      contents.boundFirstVisible();
      boundedFirst := list.firstVisible;
      adjustment := oldFirst - boundedFirst;
      boundedDelta := delta + adjustment;
      boundedAt := at - adjustment;
      (* NOTE: at+delta = boundedAt+boundedDelta *)
      IF (adjustment # 0) AND (MIN(boundedAt, at+delta) > boundedFirst) THEN
        (* extra repaint caused by bounding firstVisible *)
        (* repaint [list.firstVisible .. MIN(boundedAt, at+delta) ) *)
        clip := domain;
        clip.south := clip.north +
                (MIN(boundedAt, at+delta)-boundedFirst) * contents.height;
        VBT.Scroll(contents,
                   clip,
                   Point.T{h :=  0, v := adjustment * contents.height}
                   );
        IF adjustment > 0 THEN
          (* repaint newly exposed cells at top *)
          contents.paintCells(boundedFirst, adjustment, Rect.Full);
        END;
      END;
      IF boundedDelta # 0 THEN
        (* repaint [MIN(boundedAt, at+delta) .. ) *)
        clip := domain;
        INC(clip.north,
            (boundedAt+boundedDelta-boundedFirst) * contents.height);
        clip.south := domain.north + list.nVisible * contents.height;
        IF clip.north < clip.south THEN
          (* scroll into [at+delta .. ) *)
          VBT.Scroll(contents,
                     clip,
                     Point.T{h := 0, v := boundedDelta * contents.height}
                     );
        END;
        IF boundedDelta > 0 THEN
          (* repaint [boundedAt .. at+delta) *)
          contents.paintCells(boundedAt, boundedDelta, Rect.Full);
        END;
        IF boundedDelta < 0 THEN
          (* repaint newly exposed cells at bottom *)
          contents.paintCells(
            boundedFirst+list.nVisible+boundedDelta, -boundedDelta, Rect.Full);
        END;
      END;
    END;
  END MoveCells;

PROCEDURE PaintCells(contents: Contents; at: Cell; n: INTEGER; bad: Rect.T) =
  (* LL.sup = list *)
  VAR
    domain := VBT.Domain(contents);
    r := domain;
    start, limit: Cell;
  BEGIN
    WITH list = contents.list DO
      start := MAX(at, list.firstVisible);
      limit := MIN(MIN(at+n, list.firstVisible+list.nVisible), list.nCells);
      FOR this := start TO limit-1 DO
        r.north := domain.north + (this-list.firstVisible) * contents.height;
        r.south := r.north + contents.height;
        list.painter.paint(contents, r, list.cells^[this].value,
                                        list.cells^[this].selected,
                                        Rect.Meet (r, bad));
      END;
      IF limit < at+n THEN
        (* erase the rest of the cell positions *)
        r.north := domain.north + (limit-list.firstVisible) * contents.height;
        r.south := domain.north + (at+n-list.firstVisible) * contents.height;
        list.painter.erase(contents, r);
      END;
    END;
  END PaintCells;

PROCEDURE SelectCell(contents: Contents; this: Cell) =
  (* LL.sup = list *)
  VAR r, domain: Rect.T;
  BEGIN
    WITH list = contents.list DO
      domain := VBT.Domain(contents);
      IF domain # Rect.Empty THEN
        IF (this >= list.firstVisible) AND
                                (this < list.firstVisible + list.nVisible) THEN
          r := domain;
          INC(r.north, (this-list.firstVisible) * contents.height);
          r.south := r.north + contents.height;
          list.painter.select(contents, r, list.cells^[this].value,
                                           list.cells^[this].selected);
        END;
      END;
    END;
  END SelectCell;


(* *)
(* Implementations of Scroller methods *)
(* *)

PROCEDURE Scroll(scroller: Scroller;
                 <*UNUSED*> READONLY cd: VBT.MouseRec;
                 part: INTEGER;
                 height: INTEGER;
                 towardsEOF: BOOLEAN) =
  (* LL.sup < list *)
  VAR distance: INTEGER;
  BEGIN
    WITH list = scroller.list DO
      LOCK list.mu DO
        distance := MAX(1, (part * list.nVisible) DIV height);
        IF NOT towardsEOF THEN distance := -distance END;
        list.contents.scrollContents(list.firstVisible+distance);
      END;
    END;
  END Scroll;

PROCEDURE AutoScroll (scroller: Scroller;
                      <*UNUSED*> READONLY cd: VBT.MouseRec;
                      linesToScroll: CARDINAL;
                      towardsEOF: BOOLEAN) =
  (* LL.sup < list *)
  VAR distance: INTEGER;
  BEGIN
    WITH list = scroller.list DO
      LOCK list.mu DO
        distance := linesToScroll;
        IF NOT towardsEOF THEN distance := -distance END;
        list.contents.scrollContents(list.firstVisible+distance);
      END;
    END;
  END AutoScroll;

CONST NearEdge = 13;
    (* Thumbing closer than this to top/bottom of scroll bar is treated as
       being exactly at the top/bottom. *)

PROCEDURE Thumb (scroller: Scroller;
                 <*UNUSED*> READONLY cd: VBT.MouseRec;
                 part: INTEGER;
                 height: INTEGER) =
  (* LL.sup < list *)
  VAR position: INTEGER;
  BEGIN
    WITH list = scroller.list DO
      LOCK list.mu DO
        IF part < NearEdge THEN
          position := 0
        ELSIF part + NearEdge > height THEN
          position := list.nCells
        ELSE
          position := (part * list.nCells) DIV height
        END;
        list.contents.scrollContents(position);
      END;
    END;
  END Thumb;


(* *)
(* Implementation of Bar method *)
(* *)

PROCEDURE BarShape(bar: Bar; ax: Axis.T; n: CARDINAL): VBT.SizeRange =
  (* LL.sup = VBT.mu.bar *)
  VAR
    sr: VBT.SizeRange;
  BEGIN
    WITH hv = HVSplit.AxisOf(VBT.Parent(bar)) DO
      IF hv = ax THEN
        sr.lo := Pts.ToScreenPixels(bar, bar.size, hv);
        sr.pref := sr.lo;
        sr.hi := sr.lo + 1;
        RETURN sr
      ELSE
        RETURN TextureVBT.T.shape(bar, ax, n)
      END
    END
  END BarShape;


(* *)
(* Implementations of TextPainter methods *)
(* *)

CONST
  Leading = 0;
  LMargin = 2;

PROCEDURE TextPainterInit(painter: TextPainter;
                          bg: PaintOp.T := PaintOp.Bg;
                          fg: PaintOp.T := PaintOp.Fg;
                          hiliteBg: PaintOp.T := PaintOp.Fg;
                          hiliteFg: PaintOp.T := PaintOp.Bg;
                          font: Font.T := Font.BuiltIn): TextPainter =
  BEGIN
    painter.mu := NEW(MUTEX);
    painter.eraseColor := bg;
    painter.textColor := PaintOp.Pair(PaintOp.Transparent, fg);
    painter.hiliteColor := hiliteBg;
    painter.hiliteTextColor := PaintOp.Pair(PaintOp.Transparent, hiliteFg);
    LOCK painter.mu DO
      painter.font := font;
    END;
    RETURN painter
  END TextPainterInit;

PROCEDURE TextPainterHeight(painter: TextPainter; v: VBT.T): INTEGER =
  (* LL.sup = list *)
  VAR bBox: Rect.T;
  BEGIN
    LOCK painter.mu DO
      bBox := VBT.BoundingBox(v, "X", painter.font);
      painter.ascent := -bBox.north;
      painter.descent := bBox.south;
    END;
    RETURN Leading + Rect.VerSize(bBox)
  END TextPainterHeight;

PROCEDURE TextPainterPaint (painter : TextPainter;
                            v       : VBT.T;
                            r       : Rect.T;
                            value   : REFANY;
                            selected: BOOLEAN;
                            bad     : Rect.T       ) =
  (* LL.sup = list *)
  VAR tintColor, textColor: PaintOp.T;
  BEGIN
    IF selected THEN
      tintColor := painter.hiliteColor;
      textColor := painter.hiliteTextColor;
    ELSE
      tintColor := painter.eraseColor;
      textColor := painter.textColor;
    END;
    VBT.PaintTint (v, bad, tintColor);
    IF value # NIL THEN
      LOCK painter.mu DO
        VBT.PaintText (
          v := v,
          pt := Point.T {h := r.west + LMargin, v :=
                         r.south - painter.descent - Leading},
          fnt := painter.font, op := textColor,
          t := NARROW (value, TEXT));
      END;
    END;
  END TextPainterPaint;

PROCEDURE TextPainterSelect(painter: TextPainter; v: VBT.T; r: Rect.T;
                            value: REFANY; selected: BOOLEAN) =
  (* LL.sup = list *)
  BEGIN
    painter.paint(v, r, value, selected, r);
  END TextPainterSelect;

PROCEDURE TextPainterErase(painter: TextPainter; v: VBT.T; r: Rect.T) =
  (* LL.sup = list *)
  BEGIN
    VBT.PaintTint(v, r, painter.eraseColor);
  END TextPainterErase;

PROCEDURE TextPainterSetFont(painter: TextPainter; v: VBT.T; font: Font.T) =
  (* LL.sup < v *)
  BEGIN
    LOCK painter.mu DO
      painter.font := font;
      VBT.Mark(v);
    END;
  END TextPainterSetFont;


(* *)
(* Implementations of UniSelector methods *)
(* *)

PROCEDURE UniSelectorInit(selector: UniSelector; l: T): Selector =
  BEGIN
    selector.list := l;
    RETURN selector
  END UniSelectorInit;

PROCEDURE UniSelectorInsideClick(selector: UniSelector;
                                 <*UNUSED*> cd: VBT.MouseRec;
                                 this: Cell) =
  (* LL.sup = VBT.mu *)
  BEGIN
    selector.list.selectOnly(this);
  END UniSelectorInsideClick;

PROCEDURE UniSelectorOutsideClick(<*UNUSED*> selector: UniSelector;
                                  <*UNUSED*> cd: VBT.MouseRec) =
  (* LL.sup = VBT.mu *)
  BEGIN
  END UniSelectorOutsideClick;

PROCEDURE UniSelectorInsideDrag(selector: UniSelector;
                                <*UNUSED*> cd: VBT.PositionRec;
                                this: Cell) =
  (* LL.sup = VBT.mu *)
  BEGIN
    selector.list.selectOnly(this);
  END UniSelectorInsideDrag;

PROCEDURE UniSelectorOutsideDrag(<*UNUSED*> selector: UniSelector;
                                 <*UNUSED*> cd: VBT.PositionRec) =
  (* LL.sup = VBT.mu *)
  BEGIN
  END UniSelectorOutsideDrag;


(* *)
(* Implementations of MultiSelector methods *)
(* *)

PROCEDURE MultiSelectorInit(selector: MultiSelector; l: T): Selector =
  BEGIN
    selector.list := l;
    RETURN selector
  END MultiSelectorInit;

PROCEDURE MultiSelectorInsideClick(selector: MultiSelector;
                                   cd: VBT.MouseRec;
                                   this: Cell) =
  (* LL.sup = VBT.mu *)
  BEGIN
    IF cd.clickType = VBT.ClickType.FirstDown THEN
      WITH list = selector.list DO
        selector.anchor := this;
        IF VBT.Modifier.Shift IN cd.modifiers THEN
          selector.adding := NOT list.isSelected(this);
        ELSE
          selector.adding := TRUE;
          list.selectNone();
        END;
        list.select(this, selector.adding);
        selector.prev := this;
      END;
    END;
  END MultiSelectorInsideClick;

PROCEDURE MultiSelectorOutsideClick(<*UNUSED*> selector: MultiSelector;
                                    <*UNUSED*> cd: VBT.MouseRec) =
  (* LL.sup = VBT.mu *)
  BEGIN
  END MultiSelectorOutsideClick;

PROCEDURE MultiSelectorInsideDrag(selector: MultiSelector;
                                  <*UNUSED*> cd: VBT.PositionRec;
                                  this: Cell) =
  (* LL.sup = VBT.mu *)
  BEGIN
    WITH list = selector.list DO
      (* There are numerous cases; either first or last loop is empty. *)
      FOR i := selector.prev TO MIN(this, selector.anchor)-1 DO
        (* prev < this and prev < anchor: undo after prev *)
        list.select(i, NOT selector.adding);
      END;
      FOR i := MIN(this, selector.anchor+1) TO MAX(selector.anchor-1, this) DO
        (* apply between this and anchor, in either order *)
        list.select(i, selector.adding);
      END;
      FOR i := MAX(this, selector.anchor)+1 TO selector.prev DO
        (* prev > this and prev > anchor: undo up to prev *)
        list.select(i, NOT selector.adding);
      END;
      selector.prev := this;
    END;
  END MultiSelectorInsideDrag;

PROCEDURE MultiSelectorOutsideDrag(<*UNUSED*> selector: MultiSelector;
                                   <*UNUSED*> cd: VBT.PositionRec) =
  (* LL.sup = VBT.mu *)
  BEGIN
  END MultiSelectorOutsideDrag;


BEGIN
END ListVBT.