This module maintains the real screen structures. The following
invariants are maintained:
If line^[i].realLine.valid, the screen line i is an accurate rendering of characters line^[i].realLine.from up to but not including line^[i].realLine.to.
dirty is true if any line^[i].realLine.valid is false, or the information is otherwise obsolete
if dirty is false, then the line^[i].realLine.from are all in order
line^[0] through line^[lines - 1] are defined. when dirty is false, then if lines < nLines, then the remaining lines are zero-size. (The allWhiteBelow, turned and width fields are defined through nLines - 1.)
MODULE; IMPORT PaintOp, Point, Rd, Rect, Thread, VBT; IMPORT VTDef, VTBase, VTCaret, VTInterval, VTMarker, VTVirtual, VTRd, VTTexture; TYPE Block = VTDef.Block; Pixels = VTDef.Pixels; IntervalStyle = VTDef.IntervalStyle; IntervalOptions = VTDef.IntervalOptions; LineNo = VTDef.LineNo; Marker = VTDef.Marker; Tint = VTDef.Tint; TriState = VTDef.TriState; WhichEnd = VTDef.WhichEnd; PROCEDURE VTReal Change (vt: T; begin, oEnd, nEnd: I) RAISES {} = (* Change notes a change made in the mtext. *) VAR view: View; i: LineNo; d: INTEGER; BEGIN IF (oEnd = begin) AND (nEnd = begin) THEN RETURN ; END; d := nEnd - oEnd; WITH z_39 = vt^ DO view := z_39.views; WHILE view # NIL DO WITH z_40 = view^ DO IF z_40.real.lines > 0 THEN i := z_40.real.lines; LOOP IF i = 0 THEN EXIT; END; i := i - 1; WITH z_41 = z_40.real.line[i] DO IF z_41.realLine.valid THEN IF oEnd <= z_41.realLine.from THEN z_41.realLine.from := z_41.realLine.from + d; z_41.realLine.to := z_41.realLine.to + d; ELSIF begin < z_41.realLine.to THEN z_41.realLine.valid := FALSE; IF begin < z_41.realLine.from THEN z_41.realLine.from := begin; END; IF oEnd <= z_41.realLine.to THEN z_41.realLine.to := z_41.realLine.to + d; ELSIF begin < z_41.realLine.to THEN z_41.realLine.to := nEnd; END; IF i > 0 THEN Dirtied (view, i - 1, 2); ELSE Dirtied (view, i, 1); END; ELSIF begin = z_41.realLine.to THEN Dirtied (view, i, 1); ELSE EXIT; END; END; END; END; END; view := z_40.next; END; END; END; END Change; PROCEDURESetStart (view: View; at: I; turned: BOOLEAN) RAISES {} = BEGIN WITH z_42 = view^ DO IF (z_42.real.start.at # at) OR (z_42.real.start.turned # turned) THEN z_42.real.start.at := at; z_42.real.start.turned := turned; Dirtied (view, 0, 0); END; END; END SetStart; PROCEDUREUpdate (vt: T) RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted} = VAR view: View; BEGIN view := vt.views; WHILE view # NIL DO UpdateView (view); view := view.next; END; END Update; VAR boolToTriState: ARRAY BOOLEAN OF TriState; PROCEDUREUpdateView (view: View) RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted} = VAR a, b : INTEGER; justBad : BOOLEAN; bad, oClip, oTextClip: Rect.T; f : Rect.Partition; BEGIN IF (view.real.lines > 0) AND (view.real.line [0].realLine.from # view.virtual.start.at) THEN Dirtied (view, 0, 0); END; IF Rect.IsEmpty (view.rect.bad) THEN IF NOT view.real.dirty THEN RETURN; END; justBad := FALSE; ELSE Rect.Factor (view.rect.bad, view.rect.textClip, f, 0, 0); FOR i := 0 TO 4 DO IF i # 2 THEN IF NOT Rect.IsEmpty (f [i]) THEN VBT.PaintTint (view.vbt, f [i], view.vOptions.whiteBlack.bg); END; END; END; a := MAX ((view.rect.bad.north - view.rect.text.north) DIV view.lineSpacing, 0); b := MIN ((view.rect.bad.south - 1 - view.rect.text.north) DIV view.lineSpacing, view.nLines - 1); FOR i := a TO b DO WITH x = view.real.line [i] DO x.realLine.valid := FALSE; x.realLine.width := MAX (MIN (view.rect.text.east, view.rect.bad.east) - view.rect.text.west, x.realLine.width); x.realLine.allWhiteBelow := FALSE; x.realLine.turned [0] := TriState.Unknown; x.realLine.turned [1] := TriState.Unknown; END; END; view.real.lines := MAX (view.real.lines, b + 1); view.real.dirty := TRUE; justBad := view.real.firstDirty > view.real.firstAfter; IF justBad THEN bad := view.rect.bad; END; view.rect.bad := Rect.Empty; view.real.firstDirty := MIN (a, view.real.firstDirty); view.real.firstAfter := MAX (b + 1, view.real.firstAfter); END; VTCaret.Deactivate (view); TRY IF justBad THEN oClip := view.rect.clip; view.rect.clip := Rect.Meet (view.rect.clip, bad); oTextClip := view.rect.textClip; view.rect.textClip := Rect.Meet (view.rect.textClip, bad); END; TRY IF view.virtual.dirty THEN VTVirtual.UpdateView (view); END; IF justBad THEN IF NOT Rect.IsEmpty (view.rect.textClip) THEN view.real.blocks.n := 0; PaintAll ( view, (view.rect.textClip.north - view.rect.text.north) DIV view.lineSpacing, (view.rect.textClip.south - view.rect.text.north + view.lineSpacing - 1) DIV view.lineSpacing); END; ELSE a := 0; b := view.nLines; FindBlocks (view, a, b); BltBlocks (view); PaintAll (view, a, b); END; IF view.virtual.lines < view.real.lines THEN VBT.PaintTint ( view.vbt, Rect.Meet ( Rect.FromEdges (view.rect.full.west, view.rect.full.east, view.rect.text.north + view.virtual.lines * view.lineSpacing, view.rect.text.north + view.real.lines * view.lineSpacing), view.rect.clip), view.vOptions.whiteBlack.bg); FOR i := view.virtual.lines TO view.real.lines - 1 DO WITH x = view.real.line [i] DO x.realLine.width := 0; x.realLine.turned [0] := TriState.False; x.realLine.turned [1] := TriState.False; x.realLine.allWhiteBelow := TRUE; END; END; IF view.vOptions.eob THEN VBT.PaintTint ( view.vbt, Rect.Meet (Rect.FromEdges ( view.rect.full.west, view.rect.full.east, view.rect.text.north + view.real.lines * view.lineSpacing, view.rect.text.north + (view.real.lines + 1) * view.lineSpacing), view.rect.clip), view.vOptions.whiteBlack.bg); VBT.PaintTint ( view.vbt, Rect.Meet ( Rect.FromEdges ( view.rect.text.west, view.rect.text.east, view.rect.text.north + view.virtual.lines * view.lineSpacing, view.rect.text.north + view.virtual.lines * view.lineSpacing + 1), view.rect.textClip), view.vOptions.whiteBlack.fg); WITH x = view.real.line [view.virtual.lines].realLine DO x.width := view.rect.text.east - view.rect.text.west; x.allWhiteBelow := FALSE; END; END; ELSIF view.virtual.lines > view.real.lines THEN IF view.vOptions.eob THEN VBT.PaintTint ( view.vbt, Rect.Meet ( Rect.FromEdges ( view.rect.text.west, view.rect.text.east, view.rect.text.north + view.virtual.lines * view.lineSpacing, view.rect.text.north + view.virtual.lines * view.lineSpacing + 1), view.rect.textClip), view.vOptions.whiteBlack.fg); WITH x = view.real.line [view.virtual.lines].realLine DO x.width := view.rect.text.east - view.rect.text.west; x.allWhiteBelow := FALSE; END; END; END; FINALLY IF justBad THEN view.rect.clip := oClip; view.rect.textClip := oTextClip; END; END; view.real.lines := view.virtual.lines; FOR i := 0 TO view.real.lines - 1 DO view.real.line [i].realLine.valid := TRUE; END; view.real.dirty := FALSE; view.real.firstDirty := view.nLines; view.real.firstAfter := 0; FINALLY VTCaret.Reactivate (view); END; END UpdateView; PROCEDUREFindBlocks (view: View; VAR (*INOUT*) a, b: INTEGER) RAISES {} = VAR v, o: LineNo; block: Block; f: I; BEGIN WITH z_52 = view^ DO z_52.real.blocks.n := 0; o := z_52.real.firstDirty; v := MAX (a, z_52.real.firstDirty); a := v; b := MIN (b, z_52.virtual.lines); (* find good blocks to carry over *) LOOP (* find a valid old line *) WHILE (o < z_52.real.lines) AND NOT z_52.real.line[o].realLine.valid DO o := o + 1; END; IF NOT (o < z_52.real.lines) THEN EXIT; END; (* try to match it to some desired result *) f := z_52.real.line[o].realLine.from; WHILE (v < b) AND (z_52.virtual.line[v].virtualLine.from < f) DO v := v + 1; END; IF NOT (v < b) THEN EXIT; END; (* does it carry over? *) IF (z_52.virtual.line[v].virtualLine.from = f) AND (z_52.virtual.line[v].virtualLine.to = z_52.real.line[o].realLine.to) THEN block.old := o; block.new := v; LOOP o := o + 1; v := v + 1; IF NOT ((o < z_52.real.lines) AND (v < b)) THEN EXIT; END; WITH z_53 = z_52.real.line[o] DO IF NOT (z_53.realLine.valid AND (z_53.realLine.from = z_52.virtual.line[v].virtualLine.from) AND (z_53.realLine.to = z_52.virtual.line[v].virtualLine.to)) THEN EXIT; END; END; IF (o = v) AND NOT (v < z_52.real.firstAfter) THEN b := v; EXIT; END; END; block.length := o - block.old; z_52.real.blocks.block[z_52.real.blocks.n].block := block; z_52.real.blocks.n := z_52.real.blocks.n + 1; v := v - 1; o := o - 1; END; (* iterate *) o := o + 1; END; END; END FindBlocks; PROCEDUREBltBlocks (view: View) RAISES {} = PROCEDURE Blt (READONLY block: Block) RAISES {} = BEGIN WITH z_54 = view^ DO <* ASSERT block.old >= 0 AND block.old + block.length <= z_54.nLines AND block.new >= 0 AND block.new + block.length <= z_54.nLines *> VBT.Scroll ( z_54.vbt, Rect.Meet (Rect.FromEdges ( z_54.rect.full.west, z_54.rect.full.east, z_54.rect.text.north + block.new * z_54.lineSpacing, z_54.rect.text.north + (block.new + block.length) * z_54.lineSpacing), z_54.rect.clip), Point.FromCoords (0, (block.new - block.old) * z_54.lineSpacing), PaintOp.Copy); END; END Blt; PROCEDURE BltUp (READONLY block: Block) RAISES {} = VAR i: INTEGER; BEGIN Blt (block); WITH z_55 = view^ DO FOR z_56 := 0 TO block.length - 1 DO i := z_56; z_55.real.line [block.new + i] := z_55.real.line [block.old + i]; END; END; END BltUp; PROCEDURE BltDown (READONLY block: Block) RAISES {} = VAR i: INTEGER; BEGIN Blt (block); WITH z_57 = view^ DO FOR z_58 := block.length - 1 TO 0 BY -1 DO i := z_58; z_57.real.line [block.new + i] := z_57.real.line [block.old + i]; END; END; END BltDown; VAR b, bb, start: INTEGER; BEGIN b := 0; WITH z_59 = view^ DO WHILE b < z_59.real.blocks.n DO (* skip stationary blocks *) WHILE (b < z_59.real.blocks.n) AND (z_59.real.blocks.block [b].block.old = z_59.real.blocks.block [b].block.new) DO b := b + 1; END; (* blocks to be moved up: do them first to last *) start := b; WHILE (b < z_59.real.blocks.n) AND (z_59.real.blocks.block [b].block.old > z_59.real.blocks.block [b].block.new) DO b := b + 1; END; FOR z_60 := start TO b - 1 DO bb := z_60; BltUp (z_59.real.blocks.block [bb].block); END; (* blocks to be moved down: do them last to first *) start := b; WHILE (b < z_59.real.blocks.n) AND (z_59.real.blocks.block [b].block.old < z_59.real.blocks.block [b].block.new) DO b := b + 1; END; FOR z_61 := b - 1 TO start BY -1 DO bb := z_61; BltDown (z_59.real.blocks.block [bb].block); END; END; END; END BltBlocks; PROCEDUREPaintAll (view: View; l0, l1: CARDINAL) RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted} = VAR at : I; rdSet : BOOLEAN; rdIndex: I; BEGIN VTInterval.Fix (view.vt); VTMarker.Fix (view.vt); at := l0; rdSet := FALSE; FOR b := 0 TO view.real.blocks.n - 1 DO WITH bb = view.real.blocks.block [b] DO PaintGap (view, at, bb.block.new, rdSet, rdIndex); at := bb.block.new + bb.block.length; END; END; PaintGap (view, at, l1, rdSet, rdIndex); END PaintAll; PROCEDUREPaintGap ( view : View; l0, l1 : CARDINAL; VAR (* INOUT *) rdSet : BOOLEAN; VAR (* INOUT *) rdIndex: I ) RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted} = VAR i : LineNo; length : CARDINAL; f, t : I; turned0, turned1: BOOLEAN; BEGIN IF l0 >= l1 THEN RETURN; END; WITH z_65 = view^ DO length := z_65.vt.length; IF l0 = 0 THEN turned0 := z_65.real.start.turned; ELSE turned0 := z_65.virtual.line [l0 - 1].virtualLine.turned; END; FOR z_66 := l0 TO z_65.virtual.lines - 1 DO i := z_66; WITH z_67 = z_65.real.line [i] DO WITH z_68 = z_65.virtual.line [i] DO IF z_65.vOptions.turnMargin > 0 THEN turned0 := (turned0 AND z_65.vOptions.wrap) OR ((z_65.vOptions.leftOffset > 0) AND (z_68.virtualLine.from < length)); IF boolToTriState [turned0] # z_67.realLine.turned [0] THEN PaintTurn ( view, z_65.rect.full.west, z_65.rect.text.north + i * z_65.lineSpacing, turned0); z_67.realLine.turned [0] := boolToTriState [turned0]; END; END; IF i >= l1 THEN RETURN; END; f := MIN (z_68.virtualLine.from, length); t := MIN (z_68.virtualLine.to, length); PaintLine (view, i, f, t, rdSet, rdIndex); turned1 := z_68.virtualLine.turned OR (z_68.virtualLine.width > z_65.lineWidth); z_67.realLine.from := z_68.virtualLine.from; z_67.realLine.to := z_68.virtualLine.to; IF z_65.vOptions.turnMargin > 0 THEN IF boolToTriState [turned1] # z_67.realLine.turned [1] THEN PaintTurn ( view, z_65.rect.full.east - z_65.vOptions.turnMargin, z_65.rect.text.north + i * z_65.lineSpacing, turned1); z_67.realLine.turned [1] := boolToTriState [turned1]; END; END; turned0 := z_68.virtualLine.turned; END; END; END; END; END PaintGap; PROCEDUREPaintLine ( view : View; i : LineNo; from, to: I; VAR (* INOUT *) rdSet : BOOLEAN; VAR (* INOUT *) rdIndex : I ) RAISES {Rd.Failure, Rd.EndOfFile, Thread.Alerted} = CONST BufferSize = 128; VAR v : Pixels; h, oldWidth : Pixels; length : CARDINAL; intervalOptions : IntervalOptions; at, l, r, until : I; chars : ARRAY [0 .. BufferSize - 1] OF CHAR; oldAllWhiteBelow: BOOLEAN; VAR marker : Marker; leftSide, rightSide: Point.T; stroke : Tint; BEGIN WITH z_69 = view^ DO WITH z_70 = z_69.real.line [i] DO v := z_69.rect.text.north + i * z_69.lineSpacing; WITH sf = z_69.vScreenFont^ DO oldAllWhiteBelow := z_70.realLine.allWhiteBelow; oldWidth := z_70.realLine.width; z_70.realLine.allWhiteBelow := TRUE; z_70.realLine.width := 0; h := z_69.rect.text.west; IF rdSet THEN IF rdIndex # from THEN Rd.Seek (z_69.vt.rd, from); END; ELSE VTRd.InitReaderIx (z_69.vt, from); rdIndex := from; rdSet := TRUE; END; at := from; IF NOT sf.paintOpaque THEN VBT.BeginGroup (z_69.vbt, 3 * (to - from)); WHILE at < to DO intervalOptions := VTInterval.CurrentOptions (view, at, l, r); until := MIN (to, r); length := until - at; IF length > BufferSize THEN length := BufferSize; until := at + length; END; WITH a = Rd.GetSub (z_69.vt.rd, SUBARRAY (chars, 0, length)) DO <* ASSERT a = length *> END; PaintBackgroundTransparent ( view, h, v, chars, length, intervalOptions, oldAllWhiteBelow, z_70.realLine.allWhiteBelow, oldWidth, z_70.realLine.width); at := until; END; h := z_69.rect.text.west; Rd.Seek (z_69.vt.rd, from); at := from; END; WHILE at < to DO intervalOptions := VTInterval.CurrentOptions (view, at, l, r); until := MIN (to, r); length := until - at; IF length > BufferSize THEN length := BufferSize; until := at + length; END; WITH a = Rd.GetSub (z_69.vt.rd, SUBARRAY (chars, 0, length)) DO <* ASSERT a = length *> END; IF sf.paintOpaque THEN PaintSegmentOpaque ( view, h, v, chars, length, intervalOptions, oldAllWhiteBelow, z_70.realLine.allWhiteBelow, oldWidth, z_70.realLine.width, at = l, until = r); ELSE PaintSegmentTransparent ( view, h, v, chars, length, intervalOptions, oldAllWhiteBelow, z_70.realLine.allWhiteBelow, oldWidth, z_70.realLine.width); END; at := until; END; IF NOT sf.paintOpaque THEN h := z_69.rect.text.west; Rd.Seek (z_69.vt.rd, from); at := from; WHILE at < to DO intervalOptions := VTInterval.CurrentOptions (view, at, l, r); until := MIN (to, r); length := until - at; PaintOverlayTransparent ( view, h, v, z_69.vt.rd, length, intervalOptions, oldAllWhiteBelow, z_70.realLine.allWhiteBelow, oldWidth, z_70.realLine.width, at = l, until = r); at := until; END; END; IF h < z_69.rect.text.west + oldWidth THEN VBT.PaintTint ( z_69.vbt, Rect.Meet ( Rect.FromEdges (h, z_69.rect.text.west + oldWidth, v, v + z_69.lineSpacing), z_69.rect.textClip), z_69.vOptions.whiteBlack.bg); END; rdIndex := to; marker := VTMarker.FirstMarker (z_69.vt, from); WHILE (marker # NIL) AND (marker.index < to) DO WITH z_72 = marker^ DO VTBase.UnsafeLocatePoint (view, z_72.index, leftSide); VTBase.UnsafeLocatePoint (view, z_72.index, rightSide, 0); rdSet := FALSE; <* ASSERT leftSide.h < rightSide.h *>(* zero-width character position *) stroke := z_72.options.stroke; CASE z_72.options.whichEnd OF | WhichEnd.Left => VBT.PaintTint ( z_69.vbt, Rect.Meet (Rect.FromEdges ( leftSide.h, leftSide.h + 1, v, v + (sf.box.south - sf.box.north)), z_69.rect.textClip), stroke); | WhichEnd.Right => VBT.PaintTint ( z_69.vbt, Rect.Meet (Rect.FromEdges ( rightSide.h - 1, rightSide.h, v, v + (sf.box.south - sf.box.north)), z_69.rect.textClip), stroke); END; IF z_72.options.top THEN VBT.PaintTint ( z_69.vbt, Rect.Meet ( Rect.FromEdges (leftSide.h, rightSide.h, v, v + 1), z_69.rect.textClip), stroke); END; IF z_72.options.bottom THEN VBT.PaintTint ( z_69.vbt, Rect.Meet (Rect.FromEdges ( leftSide.h, rightSide.h, v + (sf.box.south - sf.box.north) - 1, v + (sf.box.south - sf.box.north)), z_69.rect.textClip), stroke); END; IF (z_72.options.whichEnd = WhichEnd.Left) AND NOT z_72.options.top AND NOT z_72.options.bottom THEN z_70.realLine.width := MAX (z_70.realLine.width, leftSide.h + 1 - z_69.rect.text.west); ELSE z_70.realLine.width := MAX ( z_70.realLine.width, rightSide.h - z_69.rect.text.west); END; VTMarker.NextMarker (z_72.vt, marker); END; END; IF NOT sf.paintOpaque THEN VBT.EndGroup (z_69.vbt); END; END; END; END; END PaintLine; PROCEDUREPaintSegmentOpaque ( view : View; VAR (* INOUT *) h : Pixels; v : Pixels; READONLY chars : ARRAY OF CHAR; length: CARDINAL; READONLY intervalOptions : IntervalOptions; oldAllWhiteBelow: BOOLEAN; VAR (* OUT *) allWhiteBelow: BOOLEAN; oldWidth: Pixels; VAR (* OUT *) newWidth: Pixels; atStyleStart, atStyleStop0: BOOLEAN) RAISES {} = VAR charht : Pixels; h0 : Pixels; ci, ci0 : INTEGER (* CARDINAL *); atStyleStop: BOOLEAN; PROCEDURE PaintSub (READONLY chars : ARRAY OF CHAR; start, length: CARDINAL ) RAISES {} = VAR refpt: Point.T; clip : Rect.T; BEGIN WITH sf = view.vScreenFont, vFont = sf.vFont DO IF (h0 < view.rect.textClip.east) AND (h > view.rect.textClip.west) THEN refpt := Point.FromCoords (h0 - sf.box.west, v - sf.box.north); CASE intervalOptions.style OF | IntervalStyle.NoStyle => VBT.PaintSub ( view.vbt, view.rect.textClip, refpt, vFont.font, SUBARRAY (chars, start, length), view.vOptions.whiteBlack.bgFg); FillLeading (view.vOptions.whiteBlack.bg); | IntervalStyle.HighlightStyle => VBT.PaintSub ( view.vbt, view.rect.textClip, refpt, vFont.font, SUBARRAY (chars, start, length), intervalOptions.whiteBlack.bgFg); FillLeading (intervalOptions.leading); | IntervalStyle.InverseStyle => VBT.PaintSub ( view.vbt, view.rect.textClip, refpt, vFont.font, SUBARRAY (chars, start, length), intervalOptions.whiteBlack.fgBg); FillLeading (intervalOptions.leading); | IntervalStyle.GrayStyle => VBT.PaintSub ( view.vbt, view.rect.textClip, refpt, vFont.font, SUBARRAY (chars, start, length), intervalOptions.whiteBlack.bgFg); VBT.PaintTexture ( view.vbt, Rect.Meet (Rect.FromEdges (h0, h, v, v + charht), view.rect.textClip), intervalOptions.whiteBlack.bgTransparent, VTTexture.gray, Point.FromCoords (view.rect.text.west, v)); FillLeading (intervalOptions.leading); | IntervalStyle.UnderlineStyle => IF view.vOptions.leading > 0 THEN clip := Rect.Meet (Rect.FromEdges (h0, h, v, v + charht - 1), view.rect.textClip); VBT.PaintSub (view.vbt, clip, refpt, vFont.font, SUBARRAY (chars, start, length), intervalOptions.whiteBlack.bgFg); VBT.PaintTint ( view.vbt, Rect.Meet (Rect.FromEdges ( h0, h, v + charht - 1, v + charht + 1), view.rect.textClip), intervalOptions.whiteStroke.fg); IF NOT (oldAllWhiteBelow AND (intervalOptions.leading.op = view.vOptions.whiteBlack.bg.op)) AND (view.vOptions.leading > 1) THEN VBT.PaintTint ( view.vbt, Rect.Meet (Rect.FromEdges ( h0, h, v + charht + 1, v + charht + view.vOptions.leading), view.rect.textClip), intervalOptions.leading); END; allWhiteBelow := FALSE; ELSE clip := Rect.Meet (Rect.FromEdges (h0, h, v, v + charht - 2), view.rect.textClip); VBT.PaintSub (view.vbt, clip, refpt, vFont.font, SUBARRAY (chars, start, length), intervalOptions.whiteBlack.bgFg); VBT.PaintTint (view.vbt, Rect.Meet ( Rect.FromEdges ( h0, h, v + charht - 2, v + charht), view.rect.textClip), intervalOptions.whiteStroke.fg); END; | IntervalStyle.ThinUnderlineStyle => clip := Rect.Meet (Rect.FromEdges (h0, h, v, v + charht - 1), view.rect.textClip); VBT.PaintSub (view.vbt, clip, refpt, vFont.font, SUBARRAY (chars, start, length), intervalOptions.whiteBlack.bgFg); VBT.PaintTint ( view.vbt, Rect.Meet ( Rect.FromEdges (h0, h, v + charht - 1, v + charht), view.rect.textClip), intervalOptions.whiteStroke.fg); FillLeading (intervalOptions.leading); | IntervalStyle.GrayUnderlineStyle => clip := Rect.Meet (Rect.FromEdges (h0, h, v, v + charht - 1), view.rect.textClip); VBT.PaintSub (view.vbt, clip, refpt, vFont.font, SUBARRAY (chars, start, length), intervalOptions.whiteBlack.bgFg); VBT.PaintTexture ( view.vbt, Rect.Meet ( Rect.FromEdges (h0, h, v + charht - 1, v + charht), view.rect.textClip), intervalOptions.whiteStroke.bgFg, VTTexture.gray, Point.FromCoords (view.rect.text.west, v)); FillLeading (intervalOptions.leading); | IntervalStyle.BoxStyle => clip := Rect.FromEdges (h0, h, v + 1, v + charht - 1); IF atStyleStart THEN clip := Rect.MoveEdge (clip, Rect.Edge.W, +1); END; IF atStyleStop THEN clip := Rect.MoveEdge (clip, Rect.Edge.E, -1); END; clip := Rect.Meet (clip, view.rect.textClip); VBT.PaintSub (view.vbt, clip, refpt, vFont.font, SUBARRAY (chars, start, length), intervalOptions.whiteBlack.bgFg); VBT.PaintTint ( view.vbt, Rect.Meet (Rect.FromEdges (h0, h, v, v + 1), view.rect.textClip), intervalOptions.whiteStroke.fg); VBT.PaintTint ( view.vbt, Rect.Meet ( Rect.FromEdges (h0, h, v + charht - 1, v + charht), view.rect.textClip), intervalOptions.whiteStroke.fg); IF atStyleStart THEN VBT.PaintTint ( view.vbt, Rect.Meet (Rect.FromEdges ( h0, h0 + 1, v, v + charht), view.rect.textClip), intervalOptions.whiteStroke.fg); END; IF atStyleStop THEN VBT.PaintTint ( view.vbt, Rect.Meet (Rect.FromEdges (h - 1, h, v, v + charht), view.rect.textClip), intervalOptions.whiteStroke.fg); END; FillLeading (intervalOptions.leading); | IntervalStyle.SlugStyle => VBT.PaintTint ( view.vbt, Rect.Meet (Rect.FromEdges (h0, h, v, v + charht), view.rect.textClip), intervalOptions.whiteStroke.fg); FillLeading (intervalOptions.leading); | IntervalStyle.OverlapStyle => VBT.PaintTexture ( view.vbt, Rect.Meet ( Rect.FromEdges ( h0, h, v, v + charht + view.vOptions.leading), view.rect.textClip), view.vOptions.whiteBlack.bgFg, VTTexture.lightGray, Point.FromCoords (view.rect.text.west, v)); VBT.PaintSub ( view.vbt, view.rect.textClip, refpt, vFont.font, SUBARRAY (chars, start, length), view.vOptions.whiteBlack.transparentFg); allWhiteBelow := FALSE; END; ELSE IF intervalOptions.style # IntervalStyle.NoStyle THEN allWhiteBelow := FALSE; END; END; newWidth := h - view.rect.text.west; END; END PaintSub; PROCEDURE PaintWhite () RAISES {} = VAR to: Rect.T; BEGIN WITH z_76 = view^ DO IF (h0 < z_76.rect.textClip.east) AND (h > z_76.rect.textClip.west) THEN to := Rect.FromEdges (h0, h, v, v + charht + z_76.vOptions.leading); IF intervalOptions.style = IntervalStyle.NoStyle THEN IF h0 < z_76.rect.text.west + oldWidth THEN VBT.PaintTint (z_76.vbt, Rect.Meet (to, z_76.rect.textClip), z_76.vOptions.whiteBlack.bg); END; ELSE CASE intervalOptions.style OF | IntervalStyle.HighlightStyle => VBT.PaintTint ( z_76.vbt, Rect.Meet (Rect.MoveEdge ( to, Rect.Edge.S, -z_76.vOptions.leading), z_76.rect.textClip), intervalOptions.whiteBlack.bg); FillLeading (intervalOptions.leading); | IntervalStyle.InverseStyle => VBT.PaintTint ( z_76.vbt, Rect.Meet (Rect.MoveEdge ( to, Rect.Edge.S, -z_76.vOptions.leading), z_76.rect.textClip), intervalOptions.whiteBlack.fg); FillLeading (intervalOptions.leading); | IntervalStyle.GrayStyle => VBT.PaintTint ( z_76.vbt, Rect.Meet (Rect.MoveEdge ( to, Rect.Edge.S, -z_76.vOptions.leading), z_76.rect.textClip), intervalOptions.whiteBlack.bg); IF z_76.vOptions.leading > 0 THEN VBT.PaintTint ( z_76.vbt, Rect.Meet ( Rect.FromEdges (h0, h, v + charht, v + charht + z_76.vOptions.leading), z_76.rect.textClip), intervalOptions.leading); END; | IntervalStyle.UnderlineStyle => IF z_76.vOptions.leading > 0 THEN VBT.PaintTint ( z_76.vbt, Rect.Meet (Rect.MoveEdge ( to, Rect.Edge.S, -(z_76.vOptions.leading + 1)), z_76.rect.textClip), intervalOptions.whiteBlack.bg); IF NOT (oldAllWhiteBelow AND (intervalOptions.leading.op = z_76.vOptions.whiteBlack.bg.op)) AND (z_76.vOptions.leading > 1) THEN VBT.PaintTint ( z_76.vbt, Rect.Meet (Rect.FromEdges ( h0, h, v + charht + 1, v + charht + z_76.vOptions.leading), z_76.rect.textClip), intervalOptions.leading); END; VBT.PaintTint ( z_76.vbt, Rect.Meet (Rect.FromEdges ( h0, h, v + charht - 1, v + charht + 1), z_76.rect.textClip), intervalOptions.whiteStroke.fg); allWhiteBelow := FALSE; ELSE VBT.PaintTint ( z_76.vbt, Rect.Meet (Rect.MoveEdge ( to, Rect.Edge.S, -(z_76.vOptions.leading + 2)), z_76.rect.textClip), intervalOptions.whiteBlack.bg); FillLeading (intervalOptions.leading); VBT.PaintTint ( z_76.vbt, Rect.Meet ( Rect.FromEdges (h0, h, v + charht - 2, v + charht), z_76.rect.textClip), intervalOptions.whiteStroke.fg); END; | IntervalStyle.ThinUnderlineStyle => VBT.PaintTint ( z_76.vbt, Rect.Meet (Rect.MoveEdge (to, Rect.Edge.S, -(z_76.vOptions.leading + 1)), z_76.rect.textClip), intervalOptions.whiteBlack.bg); FillLeading (intervalOptions.leading); VBT.PaintTint ( z_76.vbt, Rect.Meet ( Rect.FromEdges (h0, h, v + charht - 1, v + charht), z_76.rect.textClip), intervalOptions.whiteStroke.fg); | IntervalStyle.GrayUnderlineStyle => VBT.PaintTint ( z_76.vbt, Rect.Meet (Rect.MoveEdge (to, Rect.Edge.S, -(z_76.vOptions.leading + 1)), z_76.rect.textClip), intervalOptions.whiteBlack.bg); FillLeading (intervalOptions.leading); VBT.PaintTexture ( z_76.vbt, Rect.Meet ( Rect.FromEdges (h0, h, v + charht - 1, v + charht), z_76.rect.textClip), intervalOptions.whiteStroke.bgFg, VTTexture.gray, Point.FromCoords (z_76.rect.text.west, v)); | IntervalStyle.BoxStyle => to := Rect.FromEdges (h0, h, v + 1, v + charht - 1); IF atStyleStart THEN to := Rect.MoveEdge (to, Rect.Edge.W, +1); END; IF atStyleStop THEN to := Rect.MoveEdge (to, Rect.Edge.E, -1); END; VBT.PaintTint ( z_76.vbt, Rect.Meet (to, z_76.rect.textClip), intervalOptions.whiteBlack.bg); FillLeading (intervalOptions.leading); VBT.PaintTint ( z_76.vbt, Rect.Meet (Rect.FromEdges (h0, h, v, v + 1), z_76.rect.textClip), intervalOptions.whiteStroke.fg); VBT.PaintTint ( z_76.vbt, Rect.Meet ( Rect.FromEdges (h0, h, v + charht - 1, v + charht), z_76.rect.textClip), intervalOptions.whiteStroke.fg); IF atStyleStart THEN VBT.PaintTint ( z_76.vbt, Rect.Meet (Rect.FromEdges (h0, h0 + 1, v, v + charht), z_76.rect.textClip), intervalOptions.whiteStroke.fg); END; IF atStyleStop THEN VBT.PaintTint ( z_76.vbt, Rect.Meet (Rect.FromEdges (h - 1, h, v, v + charht), z_76.rect.textClip), intervalOptions.whiteStroke.fg); END; | IntervalStyle.SlugStyle => VBT.PaintTint ( z_76.vbt, Rect.Meet (Rect.FromEdges (h0, h, v, v + charht), z_76.rect.textClip), intervalOptions.whiteStroke.fg); FillLeading (intervalOptions.leading); | IntervalStyle.OverlapStyle => VBT.PaintTexture ( z_76.vbt, Rect.Meet ( Rect.FromEdges ( h0, h, v, v + charht + z_76.vOptions.leading), z_76.rect.textClip), z_76.vOptions.whiteBlack.bgFg, VTTexture.lightGray, Point.FromCoords (z_76.rect.text.west, v)); allWhiteBelow := FALSE; ELSE <* ASSERT(FALSE) *> END; newWidth := h - z_76.rect.text.west; END; ELSE IF intervalOptions.style # IntervalStyle.NoStyle THEN allWhiteBelow := FALSE; END; newWidth := h - z_76.rect.text.west; END; END; END PaintWhite; PROCEDURE FillLeading (tint: Tint) RAISES {} = VAR white: BOOLEAN; BEGIN WITH z_77 = view^ DO white := (tint.op = z_77.vOptions.whiteBlack.bg.op); IF NOT (oldAllWhiteBelow AND white) THEN IF z_77.vOptions.leading > 0 THEN VBT.PaintTint ( z_77.vbt, Rect.Meet (Rect.FromEdges ( h0, h, v + charht, v + charht + z_77.vOptions.leading), z_77.rect.textClip), tint); IF NOT white THEN allWhiteBelow := FALSE; END; END END; END; END FillLeading; VAR xx : INTEGER (* Pixels *); c : CHAR; escape : ARRAY [0 .. 3] OF CHAR; black : Tint; charClip: Rect.T; BEGIN WITH sf = view.vScreenFont^ DO WITH z_80 = sf.vFont^ DO charht := sf.box.south - sf.box.north; h0 := h; ci0 := 0; ci := 0; atStyleStop := FALSE; WHILE (ci < length) DO c := chars [ci]; IF c IN sf.defined THEN h := h + sf.width [c]; ELSE IF ci > ci0 THEN PaintSub (chars, ci0, ci - ci0); END; ci0 := ci + 1; atStyleStart := FALSE; IF ci0 = length THEN atStyleStop := atStyleStop0; END; h0 := h; IF c = '\n' OR c = '\r' THEN h := view.rect.text.east; PaintWhite (); ELSIF (c = '\t') AND ('\t' IN z_80.printable) THEN xx := h - view.rect.text.west; xx := xx + sf.width [' '] + sf.width ['\t'] - 1; xx := xx - xx MOD sf.width ['\t']; h := xx + view.rect.text.west; PaintWhite (); IF NOT z_80.whiteTabs THEN CASE intervalOptions.style OF | IntervalStyle.NoStyle, IntervalStyle.OverlapStyle => black := view.vOptions.whiteBlack.fg; | IntervalStyle.InverseStyle => black := intervalOptions.whiteBlack.bg; ELSE black := intervalOptions.whiteBlack.fg; END; charClip := Rect.Meet (Rect.FromEdges (h0, h, v, v + charht), view.rect.textClip); VBT.PaintTint ( view.vbt, Rect.Meet ( Rect.FromEdges ( h0 + 1, h0 + 2, v - sf.box.north - 3, v - sf.box.north - 1), charClip), black); VBT.PaintTint ( view.vbt, Rect.Meet ( Rect.FromEdges ( h0 + 2, h - 1, v - sf.box.north - 1, v - sf.box.north), charClip), black); VBT.PaintTint ( view.vbt, Rect.Meet ( Rect.FromEdges ( h - 1, h, v - sf.box.north - 3, v - sf.box.north - 1), charClip), black); IF sf.box.south < 0 THEN allWhiteBelow := FALSE; END; newWidth := h - view.rect.text.west; END; ELSE escape [0] := '\\'; escape [1] := VAL (ORD (c) DIV 64 + ORD ('0'), CHAR); escape [2] := VAL (ORD (c) DIV 8 MOD 8 + ORD ('0'), CHAR); escape [3] := VAL (ORD (c) MOD 8 + ORD ('0'), CHAR); h := h + sf.width [c]; PaintSub (escape, 0, 4); END; h0 := h; END; ci := ci + 1; END; atStyleStop := atStyleStop0; IF ci > ci0 THEN PaintSub (chars, ci0, ci - ci0); END; END; END; END PaintSegmentOpaque; PROCEDUREPaintBackgroundTransparent ( view: View; VAR (* INOUT *) h : Pixels; v : Pixels; READONLY chars : ARRAY OF CHAR; length: CARDINAL; READONLY intervalOptions: IntervalOptions; <* UNUSED *> oldAllWhiteBelow: BOOLEAN; VAR (* OUT *) allWhiteBelow: BOOLEAN; oldWidth: Pixels; VAR (* OUT *) newWidth: Pixels) RAISES {} = VAR charht : Pixels; h0 : INTEGER (* Pixels *); ci, ci0: INTEGER (* CARDINAL *); (* PROCEDURE PaintSub( VAR IN chars: ARRAY OF CHAR; start, length: CARDINAL) RAISES {}; VAR refpt: Point.T; clip: Rect.T; BEGIN WITH view^ DO WITH vScreenFont^ DO WITH vScreenFont.vFont^ DO IF (h0 < rect.textClip.east) AND (h > rect.textClip.west) THEN refpt := Point.FromCoords(h0, v - vScreenFont.box.north); CASE intervalOptions.style OF | NoStyle: VBT.PaintSub(vbt, rect.textClip, refpt, vFont.font, chars, start, length, vOptions.whiteBlack^.bgFg); | HighlightStyle: VBT.PaintSub(vbt, rect.textClip, refpt, vFont.font, chars, start, length, intervalOptions.whiteBlack^.bgFg); | InverseStyle: VBT.PaintSub(vbt, rect.textClip, refpt, vFont.font, chars, start, length, intervalOptions.whiteBlack^.fgbg); | GrayStyle: VBT.PaintSub(vbt, rect.textClip, refpt, vFont.font, chars, start, length, intervalOptions.whiteBlack^.bgFg); | UnderlineStyle: IF vOptions.leading > 0 THEN clip := Rect.Meet( Rect.FromEdges(h0, h, v, v + charht - 1), rect.textClip); ELSE clip := Rect.Meet( Rect.FromEdges(h0, h, v, v + charht - 2), rect.textClip); END; VBT.PaintSub(vbt, clip, refpt, vFont.font, chars, start, length, intervalOptions.whiteBlack^.bgFg); | ThinUnderlineStyle, GrayUnderlineStyle: clip := Rect.Meet(Rect.FromEdges(h0, h, v, v + charht - 1), rect.textClip); VBT.PaintSub(vbt, clip, refpt, vFont.font, chars, start, length, intervalOptions.whiteBlack^.bgFg); | BoxStyle: clip := Rect.FromEdges(h0, h, v + 1, v + charht - 1); clip := Rect.Meet(clip, rect.textClip); VBT.PaintSub(vbt, clip, refpt, vFont.font, chars, start, length, intervalOptions.whiteBlack^.bgFg); | SlugStyle: | OverlapStyle: VBT.PaintTexture(vbt, Rect.Meet( Rect.FromEdges(h0, h, v, v + charht + vOptions.leading), rect.textClip), vOptions.whiteBlack^.bgFg, VTTexture.lightGray, Point.FromCoords(rect.text.west, v)); VBT.PaintSub(vbt, rect.textClip, refpt, vFont.font, chars, start, length, vOptions.whiteBlack^.transparentFg); allWhiteBelow := FALSE; END; ELSE IF intervalOptions.style # NoStyle THEN allWhiteBelow := FALSE; END; END; newWidth := h - rect.text.west; END; END; END; END PaintSub; *) PROCEDURE PaintWhite () RAISES {} = VAR to: Rect.T; BEGIN WITH z_81 = view^ DO IF (h0 < z_81.rect.textClip.east) AND (h > z_81.rect.textClip.west) THEN to := Rect.FromEdges (h0, h, v, v + charht + z_81.vOptions.leading); IF intervalOptions.style = IntervalStyle.NoStyle THEN IF h0 < z_81.rect.text.west + oldWidth THEN VBT.PaintTint (z_81.vbt, Rect.Meet (to, z_81.rect.textClip), z_81.vOptions.whiteBlack.bg); END; ELSE CASE intervalOptions.style OF | IntervalStyle.HighlightStyle => VBT.PaintTint ( z_81.vbt, Rect.Meet (Rect.MoveEdge ( to, Rect.Edge.S, -z_81.vOptions.leading), z_81.rect.textClip), intervalOptions.whiteBlack.bg); | IntervalStyle.InverseStyle => VBT.PaintTint ( z_81.vbt, Rect.Meet (Rect.MoveEdge ( to, Rect.Edge.S, -z_81.vOptions.leading), z_81.rect.textClip), intervalOptions.whiteBlack.fg); | IntervalStyle.GrayStyle => VBT.PaintTint ( z_81.vbt, Rect.Meet (Rect.MoveEdge ( to, Rect.Edge.S, -z_81.vOptions.leading), z_81.rect.textClip), intervalOptions.whiteBlack.bg); | IntervalStyle.UnderlineStyle => IF z_81.vOptions.leading > 0 THEN VBT.PaintTint ( z_81.vbt, Rect.Meet (Rect.MoveEdge ( to, Rect.Edge.S, -(z_81.vOptions.leading + 1)), z_81.rect.textClip), intervalOptions.whiteBlack.bg); ELSE VBT.PaintTint ( z_81.vbt, Rect.Meet (Rect.MoveEdge ( to, Rect.Edge.S, -(z_81.vOptions.leading + 2)), z_81.rect.textClip), intervalOptions.whiteBlack.bg); END; | IntervalStyle.GrayUnderlineStyle, IntervalStyle.ThinUnderlineStyle => VBT.PaintTint ( z_81.vbt, Rect.Meet (Rect.MoveEdge (to, Rect.Edge.S, -(z_81.vOptions.leading + 1)), z_81.rect.textClip), intervalOptions.whiteBlack.bg); | IntervalStyle.BoxStyle => to := Rect.FromEdges (h0, h, v + 1, v + charht - 1); VBT.PaintTint ( z_81.vbt, Rect.Meet (to, z_81.rect.textClip), intervalOptions.whiteBlack.bg); | IntervalStyle.SlugStyle => | IntervalStyle.OverlapStyle => VBT.PaintTexture ( z_81.vbt, Rect.Meet ( Rect.FromEdges ( h0, h, v, v + charht + z_81.vOptions.leading), z_81.rect.textClip), z_81.vOptions.whiteBlack.bgFg, VTTexture.lightGray, Point.FromCoords (z_81.rect.text.west, v)); allWhiteBelow := FALSE; ELSE <* ASSERT(FALSE) *> END; newWidth := h - z_81.rect.text.west; END; ELSE IF intervalOptions.style # IntervalStyle.NoStyle THEN allWhiteBelow := FALSE; END; newWidth := h - z_81.rect.text.west; END; END; END PaintWhite; VAR xx : INTEGER (* Pixels *); c : CHAR; escape : ARRAY [0 .. 3] OF CHAR; black : Tint; charClip: Rect.T; BEGIN WITH sf = view.vScreenFont^ DO WITH z_84 = sf.vFont^ DO charht := sf.box.south - sf.box.north; h0 := h; ci0 := 0; ci := 0; WHILE (ci < length) DO c := chars [ci]; IF c IN sf.defined THEN h := h + sf.width [c]; ELSE IF ci > ci0 THEN (* PaintSub(chars, ci0, ci - ci0); *) PaintWhite (); END; ci0 := ci + 1; h0 := h; IF c = '\n' OR c = '\r' THEN h := view.rect.text.east; PaintWhite (); ELSIF (c = '\t') AND ('\t' IN z_84.printable) THEN xx := h - view.rect.text.west; xx := xx + sf.width [' '] + sf.width ['\t'] - 1; xx := xx - xx MOD sf.width ['\t']; h := xx + view.rect.text.west; PaintWhite (); IF NOT z_84.whiteTabs THEN CASE intervalOptions.style OF | IntervalStyle.NoStyle, IntervalStyle.OverlapStyle => black := view.vOptions.whiteBlack.fg; | IntervalStyle.InverseStyle => black := intervalOptions.whiteBlack.bg; ELSE black := intervalOptions.whiteBlack.fg; END; charClip := Rect.Meet (Rect.FromEdges (h0, h, v, v + charht), view.rect.textClip); VBT.PaintTint ( view.vbt, Rect.Meet ( Rect.FromEdges ( h0 + 1, h0 + 2, v - sf.box.north - 3, v - sf.box.north - 1), charClip), black); VBT.PaintTint ( view.vbt, Rect.Meet ( Rect.FromEdges ( h0 + 2, h - 1, v - sf.box.north - 1, v - sf.box.north), charClip), black); VBT.PaintTint ( view.vbt, Rect.Meet ( Rect.FromEdges ( h - 1, h, v - sf.box.north - 3, v - sf.box.north - 1), charClip), black); IF sf.box.south < 0 THEN allWhiteBelow := FALSE; END; newWidth := h - view.rect.text.west; END; ELSE escape [0] := '\\'; escape [1] := VAL (ORD (c) DIV 64 + ORD ('0'), CHAR); escape [2] := VAL (ORD (c) DIV 8 MOD 8 + ORD ('0'), CHAR); escape [3] := VAL (ORD (c) MOD 8 + ORD ('0'), CHAR); h := h + sf.width [c]; (* PaintSub(escape, 0, 4); *) PaintWhite (); END; h0 := h; END; ci := ci + 1; END; IF ci > ci0 THEN (* PaintSub(chars, ci0, ci - ci0); *) PaintWhite (); END; END; END; END PaintBackgroundTransparent; PROCEDUREPaintSegmentTransparent ( view : View; VAR (* INOUT *) h : Pixels; v : Pixels; READONLY chars : ARRAY OF CHAR; length: CARDINAL; READONLY intervalOptions: IntervalOptions; <* UNUSED *> oldAllWhiteBelow: BOOLEAN; VAR (* OUT *) allWhiteBelow: BOOLEAN; <* UNUSED *> oldWidth: Pixels; VAR (* OUT *) newWidth: Pixels) RAISES {} = VAR charht : Pixels; h0 : INTEGER (* Pixels *); ci, ci0: INTEGER (* CARDINAL *); PROCEDURE PaintSub (READONLY chars : ARRAY OF CHAR; start, length: CARDINAL ) RAISES {} = VAR refpt: Point.T; BEGIN WITH sf = view.vScreenFont^ DO WITH z_87 = sf.vFont^ DO IF (h0 < view.rect.textClip.east) AND (h > view.rect.textClip.west) THEN refpt := Point.FromCoords (h0, v - sf.box.north); CASE intervalOptions.style OF | IntervalStyle.NoStyle => VBT.PaintSub ( view.vbt, view.rect.textClip, refpt, z_87.font, SUBARRAY (chars, start, length), view.vOptions.whiteBlack.transparentFg); | IntervalStyle.HighlightStyle, IntervalStyle.GrayStyle, IntervalStyle.UnderlineStyle, IntervalStyle.GrayUnderlineStyle, IntervalStyle.ThinUnderlineStyle, IntervalStyle.BoxStyle => VBT.PaintSub ( view.vbt, view.rect.textClip, refpt, z_87.font, SUBARRAY (chars, start, length), intervalOptions.whiteBlack.transparentFg); | IntervalStyle.InverseStyle => VBT.PaintSub ( view.vbt, view.rect.textClip, refpt, z_87.font, SUBARRAY (chars, start, length), intervalOptions.whiteBlack.transparentBg); | IntervalStyle.SlugStyle => | IntervalStyle.OverlapStyle => VBT.PaintSub ( view.vbt, view.rect.textClip, refpt, z_87.font, SUBARRAY (chars, start, length), view.vOptions.whiteBlack.transparentFg); END; ELSE IF intervalOptions.style # IntervalStyle.NoStyle THEN allWhiteBelow := FALSE; END; END; newWidth := h - view.rect.text.west; END; END; END PaintSub; VAR xx : INTEGER (* Pixels *); c : CHAR; escape : ARRAY [0 .. 3] OF CHAR; black : Tint; charClip: Rect.T; BEGIN WITH sf = view.vScreenFont^ DO WITH z_90 = sf.vFont^ DO charht := sf.box.south - sf.box.north; h0 := h; ci0 := 0; ci := 0; WHILE (ci < length) DO c := chars [ci]; IF c IN sf.defined THEN h := h + sf.width [c]; ELSE IF ci > ci0 THEN PaintSub (chars, ci0, ci - ci0); END; ci0 := ci + 1; h0 := h; IF c = '\n' OR c = '\r' THEN h := view.rect.text.east; ELSIF (c = '\t') AND ('\t' IN z_90.printable) THEN xx := h - view.rect.text.west; xx := xx + sf.width [' '] + sf.width ['\t'] - 1; xx := xx - xx MOD sf.width ['\t']; h := xx + view.rect.text.west; IF NOT z_90.whiteTabs THEN CASE intervalOptions.style OF | IntervalStyle.NoStyle, IntervalStyle.OverlapStyle => black := view.vOptions.whiteBlack.fg; | IntervalStyle.InverseStyle => black := intervalOptions.whiteBlack.bg; ELSE black := intervalOptions.whiteBlack.fg; END; charClip := Rect.Meet (Rect.FromEdges (h0, h, v, v + charht), view.rect.textClip); VBT.PaintTint ( view.vbt, Rect.Meet ( Rect.FromEdges ( h0 + 1, h0 + 2, v - sf.box.north - 3, v - sf.box.north - 1), charClip), black); VBT.PaintTint ( view.vbt, Rect.Meet ( Rect.FromEdges ( h0 + 2, h - 1, v - sf.box.north - 1, v - sf.box.north), charClip), black); VBT.PaintTint ( view.vbt, Rect.Meet ( Rect.FromEdges ( h - 1, h, v - sf.box.north - 3, v - sf.box.north - 1), charClip), black); IF sf.box.south < 0 THEN allWhiteBelow := FALSE; END; newWidth := h - view.rect.text.west; END; ELSE escape [0] := '\\'; escape [1] := VAL (ORD (c) DIV 64 + ORD ('0'), CHAR); escape [2] := VAL (ORD (c) DIV 8 MOD 8 + ORD ('0'), CHAR); escape [3] := VAL (ORD (c) MOD 8 + ORD ('0'), CHAR); h := h + sf.width [c]; PaintSub (escape, 0, 4); END; h0 := h; END; ci := ci + 1; END; IF ci > ci0 THEN PaintSub (chars, ci0, ci - ci0); END; END; END; END PaintSegmentTransparent; PROCEDUREPaintOverlayTransparent ( view : View; VAR (* INOUT *) h : Pixels; v : Pixels; rd : Rd.T; length: CARDINAL; READONLY intervalOptions: IntervalOptions; oldAllWhiteBelow: BOOLEAN; VAR (* OUT *) allWhiteBelow : BOOLEAN; <* UNUSED *> oldWidth: Pixels; VAR (* OUT *) newWidth: Pixels; atStyleStart, atStyleStop: BOOLEAN) RAISES {Rd.Failure, Thread.Alerted} = VAR charht: Pixels; h0 : INTEGER (* Pixels *); buff : ARRAY [0 .. 131] OF CHAR; PROCEDURE PaintStroke () RAISES {} = VAR refpt: Point.T; BEGIN WITH sf = view.vScreenFont^ DO IF (h0 < view.rect.textClip.east) AND (h > view.rect.textClip.west) THEN refpt := Point.FromCoords (h0, v - sf.box.north); CASE intervalOptions.style OF | IntervalStyle.NoStyle => | IntervalStyle.HighlightStyle => | IntervalStyle.InverseStyle => | IntervalStyle.GrayStyle => | IntervalStyle.UnderlineStyle => IF view.vOptions.leading > 0 THEN VBT.PaintTint ( view.vbt, Rect.Meet ( Rect.FromEdges (h0, h, v + charht - 1, v + charht + 1), view.rect.textClip), intervalOptions.whiteStroke.fg); allWhiteBelow := FALSE; ELSE VBT.PaintTint ( view.vbt, Rect.Meet (Rect.FromEdges ( h0, h, v + charht - 2, v + charht), view.rect.textClip), intervalOptions.whiteStroke.fg); END; | IntervalStyle.ThinUnderlineStyle => VBT.PaintTint ( view.vbt, Rect.Meet (Rect.FromEdges ( h0, h, v + charht - 1, v + charht), view.rect.textClip), intervalOptions.whiteStroke.fg); | IntervalStyle.GrayUnderlineStyle => VBT.PaintTexture ( view.vbt, Rect.Meet (Rect.FromEdges ( h0, h, v + charht - 1, v + charht), view.rect.textClip), intervalOptions.whiteStroke.bgFg, VTTexture.gray, Point.FromCoords (view.rect.text.west, v)); | IntervalStyle.BoxStyle => VBT.PaintTint ( view.vbt, Rect.Meet (Rect.FromEdges (h0, h, v, v + 1), view.rect.textClip), intervalOptions.whiteStroke.fg); VBT.PaintTint ( view.vbt, Rect.Meet (Rect.FromEdges ( h0, h, v + charht - 1, v + charht), view.rect.textClip), intervalOptions.whiteStroke.fg); IF atStyleStart THEN VBT.PaintTint ( view.vbt, Rect.Meet (Rect.FromEdges (h0, h0 + 1, v, v + charht), view.rect.textClip), intervalOptions.whiteStroke.fg); END; IF atStyleStop THEN VBT.PaintTint ( view.vbt, Rect.Meet (Rect.FromEdges (h - 1, h, v, v + charht), view.rect.textClip), intervalOptions.whiteStroke.fg); END; | IntervalStyle.SlugStyle => VBT.PaintTint ( view.vbt, Rect.Meet (Rect.FromEdges (h0, h, v, v + charht), view.rect.textClip), intervalOptions.whiteStroke.fg); | IntervalStyle.OverlapStyle => END; ELSE IF intervalOptions.style # IntervalStyle.NoStyle THEN allWhiteBelow := FALSE; END; END; newWidth := h - view.rect.text.west; END; END PaintStroke; PROCEDURE PaintLeading () RAISES {} = VAR refpt: Point.T; BEGIN WITH sf = view.vScreenFont^ DO IF (h0 < view.rect.textClip.east) AND (h > view.rect.textClip.west) THEN refpt := Point.FromCoords (h0, v - sf.box.north); CASE intervalOptions.style OF | IntervalStyle.NoStyle => | IntervalStyle.HighlightStyle, IntervalStyle.GrayStyle, IntervalStyle.GrayUnderlineStyle, IntervalStyle.ThinUnderlineStyle, IntervalStyle.BoxStyle, IntervalStyle.SlugStyle => FillLeading (intervalOptions.leading); | IntervalStyle.InverseStyle => FillLeading (intervalOptions.leading); | IntervalStyle.UnderlineStyle => IF view.vOptions.leading > 0 THEN IF NOT (oldAllWhiteBelow AND (intervalOptions.leading.op = view.vOptions.whiteBlack.bg.op)) AND (view.vOptions.leading > 1) THEN VBT.PaintTint ( view.vbt, Rect.Meet ( Rect.FromEdges (h0, h, v + charht + 1, v + charht + view.vOptions.leading), view.rect.textClip), intervalOptions.leading); allWhiteBelow := FALSE; END; END; | IntervalStyle.OverlapStyle => END; ELSE IF intervalOptions.style # IntervalStyle.NoStyle THEN allWhiteBelow := FALSE; END; END; newWidth := h - view.rect.text.west; END; END PaintLeading; PROCEDURE FillLeading (tint: Tint) RAISES {} = VAR white: BOOLEAN; BEGIN white := (tint.op = view.vOptions.whiteBlack.bg.op); IF NOT (oldAllWhiteBelow AND white) THEN IF view.vOptions.leading > 0 THEN VBT.PaintTint ( view.vbt, Rect.Meet (Rect.FromEdges (h0, h, v + charht, v + charht + view.vOptions.leading), view.rect.textClip), tint); IF NOT white THEN allWhiteBelow := FALSE; END; END END; END FillLeading; VAR xx: INTEGER (* Pixels *); c : CHAR; BEGIN WITH box = view.vScreenFont.box DO charht := box.south - box.north; END; h0 := h; FOR i := 0 TO length - 1 BY NUMBER (buff) DO WITH count = Rd.GetSub (rd, SUBARRAY (buff, 0, MIN (NUMBER (buff), length - i))) DO FOR j := 0 TO count - 1 DO c := buff [j]; IF c = '\n' OR c = '\r' THEN h := view.rect.text.east; ELSIF c = '\t' AND '\t' IN view.vScreenFont.vFont.printable THEN xx := h - view.rect.text.west; xx := xx + view.vScreenFont.width [' '] + view.vScreenFont.width ['\t'] - 1; xx := xx - xx MOD view.vScreenFont.width ['\t']; h := xx + view.rect.text.west; ELSE h := h + view.vScreenFont.width [c]; END; END; (* FOR *) IF h > h0 THEN PaintStroke (); PaintLeading (); END; END (* WITH *) END (* FOR *) END PaintOverlayTransparent; PROCEDUREPaintTurn (view: View; w, n: Pixels; turned: BOOLEAN) RAISES {} = VAR turnNW: Point.T; BEGIN turnNW := Point.FromCoords (w, n); WITH sf = view.vScreenFont^ DO VBT.PaintTexture ( view.vbt, Rect.Meet (Rect.FromCorner (turnNW, view.vOptions.turnMargin, sf.box.south - sf.box.north), view.rect.clip), view.vOptions.whiteStroke.bgFg, VTTexture.turn [turned], turnNW); END; END PaintTurn; PROCEDUREInit (view: View) RAISES {} = (* Initialize the Real structure of a View. *) BEGIN view.rect.bad := view.rect.clip; FOR i := 0 TO view.nLines - 1 DO WITH z_103 = view.real.line [i] DO z_103.realLine.width := 0; z_103.realLine.allWhiteBelow := TRUE; z_103.realLine.turned [0] := TriState.False; z_103.realLine.turned [1] := TriState.False; END; END; view.real.lines := 0; view.real.dirty := TRUE; view.real.firstDirty := 0; view.real.firstAfter := view.nLines; END Init; PROCEDUREBad (view: View; READONLY bad: Rect.T) RAISES {} = (* Invalidate a rectangle in the image; the rectangle will be cleared and redrawn at the next Update. *) VAR b: Rect.T; BEGIN WITH z_104 = view^ DO b := Rect.Meet (bad, z_104.rect.clip); IF NOT Rect.IsEmpty (b) THEN z_104.rect.bad := Rect.Join (z_104.rect.bad, b); END; z_104.real.lines := MIN (z_104.real.lines, z_104.nLines); (* this is convenient but inelegant *) END; END Bad; PROCEDUREResize (view: View; n: CARDINAL) RAISES {} = VAR i: CARDINAL; BEGIN WITH z_105 = view^ DO IF z_105.real.lines < n THEN FOR z_106 := z_105.real.lines TO n - 1 DO i := z_106; WITH z_107 = z_105.real.line[i] DO z_107.realLine.width := 0; z_107.realLine.turned[0] := TriState.False; z_107.realLine.turned[1] := TriState.False; z_107.realLine.allWhiteBelow := TRUE; END; END; z_105.real.dirty := TRUE; z_105.real.firstDirty := MIN (z_105.real.lines, z_105.real.firstDirty); z_105.real.firstAfter := MAX (n, z_105.real.firstAfter); ELSE z_105.real.lines := n; z_105.real.firstDirty := MIN (z_105.real.firstDirty, n); z_105.real.firstAfter := MIN (z_105.real.firstAfter, n); END; END; END Resize; PROCEDUREDirtied (view: View; i: LineNo; n: CARDINAL) RAISES {} = (* Utility *) BEGIN WITH z_108 = view^ DO z_108.real.dirty := TRUE; z_108.real.firstDirty := MIN (z_108.real.firstDirty, i); z_108.real.firstAfter := MAX (z_108.real.firstAfter, i + n); END; END Dirtied; BEGIN boolToTriState[FALSE] := TriState.False; boolToTriState[TRUE] := TriState.True; END VTReal.