SimpleDisplaysViewerImpl
Copyright Ó 1990, 1992 by Xerox Corporation. All rights reserved.
Norman Adams, March 22, 1990 1:48 pm PST
Spreitze, April 3, 1990 1:53 pm PDT
Last tweaked by Mike Spreitzer on April 4, 1990 12:20:09 pm PDT
Willie-s, June 16, 1992 5:37 pm PDT
Bier, March 11, 1993 5:35 pm PST
DIRECTORY
Ascii, Basics, Char, CharDisplays, Containers, Convert, FileNames, FS, Imager, ImagerBackdoor, ImagerBox, ImagerColor, ImagerFont, InputFocus, IO, IOClasses, Menus, MessageWindow, Real, Rope, Rules, RuntimeError, SimpleDisplays, TIPLinking, TIPTableAccess, TIPTypes, TIPUser, TypeScript, ViewerClasses, ViewerForkers, ViewerIO, ViewerOps, ViewerSpecs, ViewerTools;
SimpleDisplaysViewerImpl: CEDAR MONITOR
LOCKS NARROW[ self.data, SDViewerData ].sd USING self: ViewerClasses.Viewer
IMPORTS Ascii, Basics, Char, Containers, Convert, FileNames, FS, Imager, ImagerBackdoor, ImagerBox, ImagerColor, ImagerFont, InputFocus, IO, IOClasses, Menus, MessageWindow, Real, Rope, Rules, RuntimeError, SimpleDisplays, TIPLinking, TIPTableAccess, TIPUser, TypeScript, ViewerForkers, ViewerIO, ViewerOps, ViewerSpecs, ViewerTools
EXPORTS SimpleDisplays
~ BEGIN
OPEN SimpleDisplays;
TIPTable: TYPE ~ TIPTypes.TIPTable;
myTipTableFile: Rope.ROPE ~ Rope.Concat[FileNames.CurrentWorkingDirectory[], "SimpleDisplays.tip"];
SDViewerData: TYPE ~ REF SDViewerDataRep;
SDViewerDataRep: TYPE ~ RECORD [
sd: SimpleDisplayState,
cd: CharDisplays.CharDisplay,
fromDisplayWriteEnd,
fromDisplayReadEnd: IO.STREAM,
-- Font information, assume that bold and italic have the same bounding box & origin
-- fonts[isBold][isItalic]
fonts: ARRAY BOOLEAN OF ARRAY BOOLEAN OF
RECORD [
name: Rope.ROPE,
scale: REAL ¬ 1.0,
font: Imager.Font] ¬
[      -- ~ i --        -- i --
--~b-- [ [name: "xerox/tiogafonts/gacha10"], [name: "xerox/tiogafonts/gacha10i"] ],
-- b-- [ [name: "xerox/tiogafonts/gacha10b"], [name: "xerox/tiogafonts/gacha10bi"] ]
],
le, re, des, asc: REAL,
-- Parent viewer
topViewer: Containers.Container ¬ NIL,  -- Parent
viewerOverhead: INT,
childrenInitialized: BOOLEAN ¬ FALSE,
-- Transcript
tViewer: ViewerClasses.Viewer ¬ NIL,  -- Typescript
transcriptLines: INT ¬ 5,
tHeight: INT ¬ 0,
transcriptShowing: BOOLEAN ¬ FALSE,
-- Rule between transcript and terminal
rViewer: ViewerClasses.Viewer ¬ NIL,
rHeight: INT ¬ 0,       -- 0 or rSize
rSize: INT ¬ 2,        -- size of rule separating transcript from terminal
-- Terminal and related viewer information
aViewer: ViewerClasses.Viewer ¬ NIL,  -- Array of characters, the terminal itself
aHeight: INT,
charH, charW: INT,
interlineSpace: INT ¬ 1,
leftExtraSpace: INT,     -- number of pixels to leave blanks at left[bottom] margin
bottomExtraSpace: INT ¬ 1,
topExtraSpace: INT ¬ 1,
leftReserve,       -- # pixels from left[bottom] to origin of nearest character
bottomReserve: INT,
savedVH, -- viewer height and width with next info was computed
savedVW: INT,
viewLines,       -- computed from font and viewer information
viewColumns: INT,
verticalUnused: INT,    -- vertical space unused in the viewer, in pixels
-- cursor information
cursorX: INT ¬ 0,
cursorY: INT ¬ 0,
cursorChar: CHAR ¬ ' ,
inFocus: BOOLEAN ¬ FALSE,
inFocusColor: ImagerColor.Color ¬ ImagerColor.ColorFromRGB[[1.0, 0.0, 0.0]],
outOfFocusColor: ImagerColor.Color ¬ ImagerColor.ColorFromRGB[[0.0, 1.0, 1.0]],
-- Menus
sdMenu: Menus.Menu,
transcriptME: Menus.MenuEntry,
logME: Menus.MenuEntry,
flushME: Menus.MenuEntry
-- To scroll a single line using bit blt
s1w, s1h, s1fX, s1fY, s1tX, s1tY: INT
];
SimpleDisplaysViewer:
PUBLIC PROC [sd: SimpleDisplayState, cd: CharDisplays.CharDisplay]
RETURNS [v: ViewerClasses.Viewer, fromD: IO.STREAM] = {
d: SDViewerData ¬ NEW[SDViewerDataRep];
tipTable: TIPTypes.TIPTable;
d.sdMenu ¬ Menus.CreateMenu[];
d.sd ¬ sd;
d.cd ¬ cd;
d.leftExtraSpace ¬ ViewerSpecs.scrollBarW + 3;
CacheFontInfo[d];
IF d.transcriptShowing THEN {
d.tHeight ¬ Real.Fix[ (d.charH + d.interlineSpace) * d.transcriptLines ];
d.rHeight ¬ d.rSize;
} ELSE {
d.tHeight ¬ 0;
d.rHeight ¬ 0;
};
d.aHeight ¬ Real.Fix[ d.cd.det.lines*(d.charH+d.interlineSpace) + d.bottomExtraSpace + d.topExtraSpace];
d.viewerOverhead ¬ ViewerSpecs.windowBorderSize + ViewerSpecs.menuHeight + ViewerSpecs.menuBarHeight + ViewerSpecs.captionHeight;
d.topViewer ¬ Containers.Create[ info: [ menu: d.sdMenu, scrollable: FALSE, icon: typescript ] ];
RegisterMenus[ d, d.sdMenu ];
d.tViewer ¬ TypeScript.Create[
info: [
parent: d.topViewer ,
wh: d.tHeight,
ww: d.topViewer.cw,
wy: 0,
wx: 0,
border: FALSE
]
];
Containers.ChildXBound[d.topViewer, d.tViewer];
d.sd.out ¬ ViewerIO.CreateViewerStreams[viewer: d.tViewer, name: cd.name, editedStream: FALSE].out;
d.sd.sdvData ¬ d;
d.rViewer ¬ Rules.Create[
info: [
parent: d.topViewer,
wh: d.rHeight,
ww: d.topViewer.cw,
wy: d.tHeight,
wx: 0
]
];
Containers.ChildXBound[d.topViewer, d.rViewer];
-- Make an appropriate tip table, basically just ascii with control, shift, meta. Then layer on the terminal specific tip.
tipTable ¬ TIPUser.InstantiateNewTIPTable[myTipTableFile];
IF cd.tipTableName#NIL THEN {
first: TIPTypes.TIPTable ¬ NIL;
first ¬ TIPUser.InstantiateNewTIPTable[cd.tipTableName !FS.Error, TIPUser.InvalidTable => CONTINUE];
IF first#NIL THEN {
first.mouseTicks ¬ MIN[first.mouseTicks, tipTable.mouseTicks];
TIPTableAccess.SetMouseTicks[first,
MIN[TIPTableAccess.GetMouseTicks[first],
TIPTableAccess.GetMouseTicks[tipTable]] ];
first.opaque ¬ FALSE;
TIPTableAccess.SetOpaque[first, FALSE];
[] ¬ TIPLinking.Append[early: first, late: tipTable];
tipTable ¬ first
}
};
d.aViewer ¬ ViewerOps.CreateViewer[
flavor: $SimpleDisplaysViewer,
info: [
parent: d.topViewer,
data: d,
icon: typescript,
wh: d.aHeight,
ww: d.topViewer.cw,
wy: d.tHeight + d.rHeight,
wx: 0,
border: FALSE,
tipTable: tipTable
]
];
Containers.ChildXBound[d.topViewer, d.aViewer];
Containers.ChildYBound[d.topViewer, d.aViewer];
d.topViewer.openHeight ¬ d.aHeight + d.tHeight + d.rHeight + d.viewerOverhead;
d.childrenInitialized ¬ TRUE;
ComputeLinesInfo[ d ];  -- to initialize the variables concerned
ViewerOps.OpenIcon[d.topViewer];
ViewerOps.PaintViewer[d.topViewer, ViewerOps.PaintHint.all];
[d.fromDisplayWriteEnd, d.fromDisplayReadEnd] ¬ IOClasses.CreatePipe[];
d.sd.topViewer ¬ d.topViewer;
d.sd.aViewer ¬ d.aViewer;
RETURN[ d.topViewer, d.fromDisplayReadEnd ];
};
CacheFontInfo: PROC [d:SDViewerData] ~ {
escapement: Imager.VEC;
FOR isB: BOOLEAN IN [FALSE..TRUE] DO
FOR isI: BOOLEAN IN [FALSE..TRUE] DO
d.fonts[isB][isI].font ¬ Imager.FindFontScaled[d.fonts[isB][isI].name, d.fonts[isB][isI].scale]
ENDLOOP;
ENDLOOP;
[[d.le, d.re, d.des, d.asc]] ¬ ImagerFont.FontBoundingBox[d.fonts[FALSE][FALSE].font];
escapement ¬ ImagerFont.Escapement[d.fonts[FALSE][FALSE].font, Char.Make[0,100]];
d.charH ¬ FixUp[d.des + d.asc];
d.charW ¬ FixUp[escapement.x];
d.leftReserve ¬ FixUp[d.le] + d.leftExtraSpace;
d.bottomReserve ¬ FixUp[d.des] + d.bottomExtraSpace;
};
FixUp: PROC [r:REAL] RETURNS [i:INT] ~ {
RETURN[ Real.Fix[ r+ 0.0001 ] ];
};
ComputeLinesInfo: PROC [d:SDViewerData] ~ {
vspace: INT ¬ d.topViewer.ch - d.bottomExtraSpace - d.topExtraSpace - d.tHeight - d.rHeight;
d.viewLines ¬ vspace / (d.charH+d.interlineSpace);
d.verticalUnused ¬ vspace - (d.viewLines * (d.charH+d.interlineSpace));
d.viewColumns ¬ (d.topViewer.cw-d.leftExtraSpace) / d.charW;
d.topViewer.name ¬ IO.PutFLR["%g term:%gx%g view:%gx%g", LIST[IO.rope[d.cd.name], IO.int[d.cd.det.lines], IO.int[d.cd.det.columns], IO.int[d.viewLines], IO.int[d.viewColumns]] ];
};
RepositionViewers: PROC [d: SDViewerData, force:BOOLEAN ¬ FALSE] = {
If force then try to resize the container to fit the transcript and terminal at their current sizes. When not forcing, don't change the container size. Instead, honor the size of the transcript and take away from the terminal. You need to paint after doing this.
IF d.transcriptShowing THEN {
d.tHeight ¬ Real.Fix[ (d.charH + d.interlineSpace) * d.transcriptLines ];
d.rHeight ¬ d.rSize;
} ELSE {
d.tHeight ¬ 0;
d.rHeight ¬ 0;
};
IF force THEN
d.aHeight ¬ Real.Fix[ d.cd.det.lines*(d.charH+d.interlineSpace) + d.bottomExtraSpace + d.topExtraSpace]
ELSE
d.aHeight ¬ MAX[0, FixUp[d.topViewer.ch - d.bottomExtraSpace - d.topExtraSpace - d.tHeight - d.rHeight ]];
ViewerOps.MoveViewer[ d.tViewer, 0, 0, d.tViewer.ww, d.tHeight, FALSE];
ViewerOps.MoveViewer[ d.rViewer, 0, d.tHeight, d.rViewer.ww, d.rHeight, FALSE ];
ViewerOps.MoveViewer[ d.aViewer, 0, d.tHeight + d.rHeight, d.aViewer.ww, d.aHeight, FALSE ];
ViewerOps.SetOpenHeight[d.topViewer, FixUp[d.aHeight + d.tHeight + d.rHeight + d.bottomExtraSpace + d.topExtraSpace]];
ViewerOps.ComputeColumn[ column: ViewerOps.ViewerColumn[ d.topViewer ] ];
ComputeLinesInfo[ d ];
};
Painting
PaintSimpleDisplaysViewer: ENTRY ViewerClasses.PaintProc ~ {
-- PROC [self: Viewer, context: Imager.Context, whatChanged: REF, clear: BOOL]
RETURNS [quit: BOOLFALSE];
ENABLE {
RuntimeError.BoundsFault => GO TO cantPaint;
UNWIND => NULL;
};
d: SDViewerData ¬ NARROW[self.data];
Imager.SetFont[context, d.fonts[FALSE][FALSE].font];
IF ~ clear THEN ClearCursor[ context, d ];
IF whatChanged = NIL THEN {
PaintAll[ d, context ];
} ELSE {
fixit: ATOM ¬ NARROW[ whatChanged ];
SELECT fixit FROM
$LINES => {
RearrangeScreenLines[ context, d
! Imager.Error => {
IF d.sd.debugScroll THEN d.sd.out.PutRope[ "blt failed\n" ];
FOR i: INT IN [0..d.sd.theLines.count ) DO
d.sd.theLines[i].modified ¬ new;
ENDLOOP;
CONTINUE
};
];
FOR i: INT IN [ 0.. d.cd.det.lines ) DO
l: REF LineRep = d.sd.theLines[i];
SELECT l.modified FROM
unchanged => NULL;
new => {
PaintLine[ d, context, l, 0, i, d.cd.det.columns ];
};
insert1, delete1, over1, tail => {
PaintLine[ d, context, l, l.tailStartColumn, i, d.cd.det.columns - l.tailStartColumn];
};
ENDCASE => ERROR;
l.screenLine ¬ i;
l.modified ¬ unchanged;
ENDLOOP;
};
$FOCUS => NULL;
ENDCASE => NULL;
};
PaintCursor[ context, d ];
NOTIFY d.sd.paintDone;
EXITS cantPaint => {
d: SDViewerData ¬ NARROW[self.data];
m: Rope.ROPE;
m ¬ IO.PutFLR["BoundsFault- vl:%g,vc:%g,l:%g,c:%g,termL:%g", LIST[IO.int[d.viewLines], IO.int[d.viewColumns], IO.int[d.cd.line], IO.int[d.cd.col], IO.int[d.cd.det.lines]] ];
MessageWindow.Append[m,TRUE];
NOTIFY d.sd.paintDone;
RETURN;
};
};
PaintAll: PROC [d:SDViewerData, context:Imager.Context] ~ {
FOR i: INT IN [0..d.sd.theLines.count ) DO
l: REF LineRep = d.sd.theLines[i];
PaintLine[ d, context, l, 0, i, l.chars.maxLength];
l.screenLine ¬ i;
l.modified ¬ unchanged;
ENDLOOP;
};
PaintLine:
PROC [ d:SDViewerData, context:Imager.Context, line:REF LineRep, x, y, count:INTEGER ] ~ {
chars: REF TEXT ¬ line.chars;
chars.length ¬ 0;
FOR j: INTEGER DECREASING IN [0..x+count) DO
IF chars[j] # Ascii.SP THEN { chars.length ¬ j+1; EXIT };
ENDLOOP;
IF line.hasSomeEmphasis THEN {
PaintLineWithEmphasis[ d, context, line, x, y, count ]
} ELSE {
Imager.SetGray[context, 0.0];
Imager.MaskBox[context, ImagerBox.BoundingBox[ BoxAt[d,x,y], BoxAt[d,x+count-1,y] ] ];
IF x < chars.length THEN {
Imager.SetXY[context, CharacterOriginAt[d, x, y]];
Imager.SetGray[context, 1.0];
Imager.ShowText[context, chars, x, count];
};
}
};
PaintLineWithEmphasis:
PROC [ d:SDViewerData, context:Imager.Context, line:REF LineRep, x, y, count:INTEGER ] ~ {
chars: REF TEXT ¬ line.chars;
j: INT ¬ 0;
Imager.SetGray[context, 0.0];
Imager.MaskBox[context, ImagerBox.BoundingBox[ BoxAt[d,x,y], BoxAt[d,x+count-1,y] ] ];
WHILE j < chars.length DO
emphs: CharDisplays.Emphs ¬ line.emphs[j];
k: INT ¬ j + 1;
WHILE k < chars.length AND line.emphs[k] = emphs DO k ¬ k + 1 ENDLOOP;
PaintSegWithEmphasis[ d, context, line, j, y, k-j ];
j ¬ k;
ENDLOOP;
};
-- Write from x for length of count all with the same emphasis
PaintSegWithEmphasis:
PROC [ d:SDViewerData, context:Imager.Context, line:REF LineRep, x, y, count:INTEGER ] ~ {
emphs: CharDisplays.Emphs ¬ line.emphs[x];
box: ImagerBox.Box ¬ ImagerBox.BoundingBox[ BoxAt[d, x, y], BoxAt[d, x+count-1, y] ];
Imager.SetFont[context, d.fonts[emphs[bold]][emphs[italic]].font];
Imager.SetGray[context, IF emphs[inverse] THEN 1.0 ELSE 0.0];
Imager.MaskBox[context, box ];
Imager.SetGray[context, IF emphs[inverse] THEN 0.0 ELSE 1.0];
Imager.SetXY[context, CharacterOriginAt[d, x, y]];
Imager.ShowText[context, line.chars, x, count];
IF emphs[underline] THEN {
box.ymax ¬ box.ymin + 1;
Imager.MaskBox[context, box ];
};
};
RearrangeScreenLines: PROC [c: Imager.Context, d: SDViewerData] ~ {
lineCount: INT ¬ d.sd.theLines.count;
i,j: INT;
-- For lines above the current line on the screen, relativeScreenPos = 0 (of source) means
-- the source hasn't been (won't be) overwritten. It is always OK to get lines from lower
-- on the screen
FOR i IN [ 0.. lineCount ) DO
l: REF LineRep = d.sd.theLines[i];
IF l.modified # new THEN {
rsp: INT = l.screenLine - i; -- positive RSP's are a scroll up
IF ((rsp<0) AND (d.sd.theLines[l.screenLine].relativeScreenPosition # 0)) THEN
{ l.relativeScreenPosition ¬ 0; l.modified¬ new }
ELSE
l.relativeScreenPosition ¬ rsp
} ELSE
l.relativeScreenPosition ¬ 0;
ENDLOOP;
i ¬ 0;
WHILE i < lineCount DO
startRSP: INT = d.sd.theLines[i].relativeScreenPosition;
IF (startRSP = 0) THEN { i ¬ i + 1; LOOP };
-- i and j are first and last line, resp., of region where all lines have the same RSP
j ¬ i + 1;
WHILE (j < lineCount) AND (d.sd.theLines[j].relativeScreenPosition = startRSP) DO
j ¬ j + 1;
ENDLOOP;
j ¬ j - 1;
MoveScreenLines[ c, d, i+startRSP, j+startRSP, startRSP ];
i ¬ j + 1;
ENDLOOP;
};
-- first and last are the indices of the first and last line (inclusive)
-- of the rectangle to be moved. Offset > 0 is a scroll up. Because the terminal
-- emulator counts lines starting from the top of the display, last is actually the origin
-- of the source rectangle.
MoveScreenLines: PROC [c: Imager.Context, d: SDViewerData, first, last, offset: INT] ~ {
r: ImagerBox.Rectangle;
startOrigin: ImagerBox.Box ¬ BoxAt[d, 0, last];
endOrigin: ImagerBox.Box ¬ BoxAt[d, 0, last-offset];
farCorner: ImagerBox.Box ¬ BoxAt[d, d.cd.det.columns, first];
IF d.sd.debugScroll THEN
d.sd.out.PutF[ "MoveLines[first:%g, last:%g, offset:%g]\n", IO.int[first], IO.int[last], IO.int[offset] ];
IF (offset = 0) OR (first >= d.cd.det.lines) OR (offset >= d.cd.det.lines) OR (last >= d.cd.det.lines) THEN RETURN;
r ¬ ImagerBox.RectangleFromBox[ImagerBox.BoundingBox[startOrigin, farCorner]];
ImagerBackdoor.MoveViewRectangle[ -- may generate Imager.Error, caught above
context: c,
width: Real.Fix[r.w],
height: Real.Fix[r.h],
fromX: Real.Fix[startOrigin.xmin],
fromY: Real.Fix[startOrigin.ymin],
toX: Real.Fix[endOrigin.xmin],
toY: Real.Fix[endOrigin.ymin]
];
};
Character Positions
BoxAt: PROC [d:SDViewerData, x,y: INT] RETURNS [b: ImagerBox.Box] ~ {
xmin: REAL ¬ d.leftExtraSpace + (x * d.charW);
ymin: REAL ¬ d.verticalUnused + d.bottomExtraSpace + (((d.viewLines-1)-y) * (d.charH+d.interlineSpace));
RETURN[ [
xmin: xmin,
ymin: ymin,
xmax: xmin + d.charW,
ymax: ymin + d.charH + d.interlineSpace ]]
};
CharacterOriginAt: PROC [d:SDViewerData, x,y: INT] RETURNS [p: ImagerBox.VEC] ~ {
RETURN[ [
d.leftReserve + (x * d.charW),
d.verticalUnused + d.bottomReserve + (((d.viewLines-1)-y) * (d.charH+d.interlineSpace))
] ];
};
Cursor
PaintCursor: PROC [c: Imager.Context, d: SDViewerData] = {
x: INT ¬ d.cd.col;
y: INT ¬ d.cd.line;
ch: CHAR ¬ d.sd.theLines[y].chars[x];
Imager.SetColor[ c, IF d.inFocus THEN d.inFocusColor ELSE d.outOfFocusColor ];
Imager.MaskBox[ c, BoxAt[ d, x, y ] ];
Imager.SetXY[c, CharacterOriginAt[d, x, y]];
Imager.SetGray[ c, 0.0 ];
Imager.ShowChar[ c, ch ];
d.cursorX ¬ x;
d.cursorY ¬ y;
d.cursorChar ¬ ch;
};
ClearCursor: PROC [c: Imager.Context, d: SDViewerData] = {
x: INT = d.cursorX;
y: INT = d.cursorY;
Imager.SetGray[ c, 0.0 ];
Imager.MaskBox[ c, BoxAt[ d, x, y ] ];
Imager.SetXY[c, CharacterOriginAt[d, x, y]];
Imager.SetGray[ c, 1.0 ];
Imager.ShowChar[ c, d.cursorChar ];
};
Other Viewers Procedures
NotifySimpleDisplaysViewer: -- ENTRY -- ViewerClasses.NotifyProc ~ {
-- PROC [self: Viewer, input: LIST OF REF ANY];
ENABLE UNWIND => NULL;
d: SDViewerData ¬ NARROW[self.data];
WITH input.first SELECT FROM
a: ATOM => SELECT a FROM
$TDInput => {
r: Rope.ROPE;
ctl, shift, meta: BOOL ¬ FALSE;
FOR input ¬ input.rest, input.rest WHILE input # NIL DO
WITH input.first SELECT FROM
R: Rope.ROPE => r ¬ R;
t: REF TEXT => r ¬ Rope.FromRefText[t];
b: ATOM => SELECT b FROM
$Ctl => ctl ¬ TRUE;
$Shift => shift ¬ TRUE;
$Meta => meta ¬ TRUE;
ENDCASE => ERROR;
ENDCASE => ERROR;
ENDLOOP;
FOR i: INT IN [0 .. r.Length[]) DO
c: CHAR ¬ r.Fetch[i];
IF NOT shift THEN c ¬ Ascii.Lower[c];
IF ctl THEN {
d: NAT ¬ c - 0C;
cd: NAT ¬ Basics.BITAND[d, 31];
c ¬ 0C + cd;
};
IF meta THEN c ¬ c + 128;
d.fromDisplayWriteEnd.PutChar[c];
ENDLOOP;
RETURN;
};
ENDCASE;
r: Rope.ROPE => {
d.fromDisplayWriteEnd.PutRope[r];
RETURN;
};
r: REF TEXT => {
d.fromDisplayWriteEnd.PutText[r];
RETURN;
};
mouse: TIPUser.TIPScreenCoords => {
InputFocus.SetInputFocus[self];
d.inFocus ¬ TRUE;
ViewerForkers.ForkPaint[
viewer:   d.aViewer,
hint:    ViewerClasses.PaintHint.client,
clearClient:  FALSE,
whatChanged: $FOCUS,
tryShortCuts: FALSE
];
ViewerOps.PaintViewer[d.aViewer, ViewerOps.PaintHint.client, FALSE, $FOCUS];
};
ENDCASE => {
MessageWindow.Append["TE:unhandled input type."];
};
};
ModifySimpleDisplaysViewer: -- ENTRY -- ViewerClasses.ModifyProc ~ {
ModifyProc: TYPE = PROC [self: Viewer, change: ModifyAction];
ModifyAction: TYPE = {set, push, pop, kill};
ENABLE UNWIND => NULL;
d: SDViewerData ¬ NARROW[self.data];
SELECT change FROM
ViewerClasses.ModifyAction.kill => {
d.inFocus ¬ FALSE;
ViewerForkers.ForkPaint[
viewer:   d.aViewer,
hint:    ViewerClasses.PaintHint.client,
clearClient:  FALSE,
whatChanged: $FOCUS,
tryShortCuts: FALSE
];
ViewerOps.PaintViewer[d.aViewer, ViewerOps.PaintHint.client, FALSE, $FOCUS];
};
ENDCASE => NULL;
};
AdjustSimpleDisplaysViewer: -- ENTRY -- ViewerClasses.AdjustProc ~ {
AdjustProc: TYPE = PROC [self: Viewer] RETURNS [adjusted: BOOLFALSE];
ENABLE UNWIND => NULL;
d: SDViewerData ¬ NARROW[self.data];
MessageWindow.Append["Adjust.",TRUE];
ComputeLinesInfo[ d ];
ViewerForkers.ForkPaint[
viewer:   d.topViewer,
hint:    ViewerClasses.PaintHint.caption,
clearClient:  TRUE,
whatChanged: NIL,
tryShortCuts: FALSE
];
RETURN[ TRUE ];
};
Menus
RegisterMenus: PROC [d: SDViewerData, sdMenu: Menus.Menu] ~ {
d.flushME ¬ Menus.CreateEntry[
name: IF d.sd.flushMode = FlushOnChangeCount THEN
IO.PutFR[ "%g%g", IO.rope[FlushCaptions[d.sd.flushMode]], IO.int[d.sd.changeCountLimit] ]
ELSE
FlushCaptions[d.sd.flushMode],
proc: FlushingMenuProc,
clientData: d
];
Menus.AppendMenuEntry[ menu: sdMenu, entry: d.flushME ];
d.logME ¬ Menus.CreateEntry[
name: LoggingCaptions[d.sd.logging],
proc: LoggingMenuProc,
clientData: d
];
Menus.AppendMenuEntry[ menu: sdMenu, entry: d.logME ];
d.transcriptME ¬ Menus.CreateEntry[
name: LogCaptions[d.transcriptShowing],
proc: LogMenuProc,
clientData: d
];
Menus.AppendMenuEntry[ menu: sdMenu, entry: d.transcriptME ];
Menus.AppendMenuEntry[
menu: sdMenu,
entry: Menus.CreateEntry[
name: "SetLogLines",
proc: SetLogLinesMenuProc,
clientData: d
]
];
Menus.AppendMenuEntry[
menu: sdMenu,
entry: Menus.CreateEntry[
name: "SetLines",
proc: SetLinesMenuProc,
clientData: d
]
];
Menus.AppendMenuEntry[
menu: sdMenu,
entry: Menus.CreateEntry[
name: "SetColumns",
proc: SetColumnsMenuProc,
clientData: d
]
];
Menus.AppendMenuEntry[
menu: sdMenu,
entry: Menus.CreateEntry[
name: "Grab",
proc: GrabMenuProc,
clientData: d
]
];
Menus.AppendMenuEntry[
menu: sdMenu,
entry: Menus.CreateEntry[
name: "Help",
proc: HelpMenuProc,
clientData: d
]
];
};
ReadIntSelection: PROC [lowBound:INT ¬ 0]
RETURNS [nullSelection, ok: BOOLEAN, i: INT] ~ {
r: Rope.ROPE ¬ ViewerTools.GetSelectionContents[];
nullSelection ¬ Rope.Length[r] <= 0;
ok ¬ TRUE;
IF ~ nullSelection THEN
i ¬ Convert.CardFromRope[ r
! Convert.Error => {
msg: Rope.ROPE¬ IO.PutFR1["Expecting an integer greater than %g. ", IO.int[lowBound] ];
ok ¬ FALSE;
MessageWindow.Append[msg,TRUE];
MessageWindow.Blink[];
CONTINUE;
};
];
};
LogCaptions: ARRAY BOOLEAN OF Rope.ROPE ¬ [ "Log:NotVisible", "Log:Visible" ];
LogMenuProc: Menus.MenuProc ~ {
ClickProc: TYPE = PROC [parent: Viewer, clientData: REF ANYNIL, mouseButton: MouseButton ← red, shift, control: BOOLFALSE];
d: SDViewerData ¬ NARROW[clientData];
oldME: Menus.MenuEntry ¬ d.transcriptME;
d.transcriptShowing ¬ ~ d.transcriptShowing;
d.transcriptME ¬ Menus.CreateEntry[
name: LogCaptions[d.transcriptShowing],
proc: LogMenuProc,
clientData: d
];
Menus.ReplaceMenuEntry[ d.sdMenu, oldME, d.transcriptME ];
RepositionViewers[ d:d, force: shift ];
ViewerOps.PaintViewer[ d.topViewer, ViewerOps.PaintHint.all, TRUE, NIL ];
};
SetLogLinesMenuProc: Menus.MenuProc ~ {
ClickProc: TYPE = PROC [parent: Viewer, clientData: REF ANYNIL, mouseButton: MouseButton ← red, shift, control: BOOLFALSE];
d: SDViewerData ¬ NARROW[clientData];
RepaintTranscript: PROC [showing: BOOLEAN] ~ {
IF showing # d.transcriptShowing THEN {
LogMenuProc[ parent, clientData, mouseButton, shift, control ];
} ELSE {
RepositionViewers[ d:d, force: shift ];
ViewerOps.PaintViewer[ d.topViewer, ViewerOps.PaintHint.all, TRUE, NIL ];
};
};
null, ok: BOOLEAN; i: INT;
[ nullSelection: null, ok: ok, i: i ] ¬ ReadIntSelection[ -1 ];
IF null THEN {
avail: INT ¬ (d.topViewer.ch - d.aHeight - d.rHeight) / FixUp[(d.charH+d.interlineSpace)];
IF avail > 0 THEN {
d.transcriptLines ¬ avail;
RepaintTranscript[showing: TRUE]
} ELSE {
MessageWindow.Append["Transcript would have no lines. "];
MessageWindow.Blink[];
}
} ELSE IF ok THEN {
IF i = 0 AND d.transcriptShowing THEN {
RepaintTranscript[showing: FALSE]
} ELSE {
d.transcriptLines ¬ MIN[i, (d.topViewer.ch) / FixUp[(d.charH+d.interlineSpace)] ];
RepaintTranscript[showing: TRUE]
}
}
};
LoggingCaptions: ARRAY BOOLEAN OF Rope.ROPE ¬ [ "Logging:Off", "Logging:On" ];
LoggingMenuProc: Menus.MenuProc ~ {
ClickProc: TYPE = PROC [parent: Viewer, clientData: REF ANYNIL, mouseButton: MouseButton ← red, shift, control: BOOLFALSE];
d: SDViewerData ¬ NARROW[clientData];
oldME: Menus.MenuEntry ¬ d.logME;
d.sd.logging ¬ ~ d.sd.logging;
d.logME ¬ Menus.CreateEntry[
name: LoggingCaptions[d.sd.logging],
proc: LoggingMenuProc,
clientData: d
];
Menus.ReplaceMenuEntry[ d.sdMenu, oldME, d.logME ];
ViewerOps.PaintViewer[d.topViewer, ViewerOps.PaintHint.menu, FALSE, NIL];
};
FlushCaptions: ARRAY FlushModeType OF Rope.ROPE ¬ [
FlushOnBlock: "Flush:OnBlock",
FlushOnScroll: "Flush:OnScroll",
FlushOnChangeCount: "Flush:OnCount"
];
FlushingMenuProc: Menus.MenuProc ~ {
d: SDViewerData ¬ NARROW[clientData];
oldME: Menus.MenuEntry ¬ d.flushME;
null, ok: BOOLEAN; i: INT;
[ nullSelection: null, ok: ok, i: i ] ¬ ReadIntSelection[ 0 ];
IF null THEN
IF d.sd.flushMode = LAST[ FlushModeType ] THEN
d.sd.flushMode ¬ FIRST[ FlushModeType ]
ELSE
d.sd.flushMode ¬ SUCC[ d.sd.flushMode ]
ELSE IF ok THEN {
d.sd.changeCountLimit ¬ i;
d.sd.flushMode ¬ FlushOnChangeCount;
};
d.flushME ¬ Menus.CreateEntry[
name: IF d.sd.flushMode = FlushOnChangeCount THEN
IO.PutFR[ "%g(%g)", IO.rope[FlushCaptions[d.sd.flushMode]], IO.int[d.sd.changeCountLimit] ]
ELSE
FlushCaptions[d.sd.flushMode],
proc: FlushingMenuProc,
clientData: d
];
Menus.ReplaceMenuEntry[ d.sdMenu, oldME, d.flushME ];
ViewerOps.PaintViewer[d.topViewer, ViewerOps.PaintHint.menu, FALSE, NIL];
};
GrabMenuProc: Menus.MenuProc ~ {
d: SDViewerData ¬ NARROW[clientData];
r: Rope.ROPE ¬ ViewerTools.GetSelectionContents[];
StuffCharacter: PROC [c:CHAR] RETURNS [quit: BOOL ¬ FALSE] ~ {
d.fromDisplayWriteEnd.PutChar[c];
};
[] ¬ Rope.Map[ base: r, action: StuffCharacter ];
};
HelpMenuProc: Menus.MenuProc ~ {
d: SDViewerData ¬ NARROW[clientData];
IF ~ d.transcriptShowing THEN {
LogMenuProc[ parent, clientData, mouseButton, shift, control ];
d.transcriptShowing ← TRUE;
RepositionViewers[ d:d, force:shift ];
ViewerOps.PaintViewer[ d.topViewer, ViewerOps.PaintHint.all, TRUE, NIL ];
};
d.sd.out.PutF["%lFlush%l: Cycle between 3 ways of buffering output to the terminal. With selection, set mode to flush every N characters. (Use the selection as the value of N.)\n", IO.rope["b"], IO.rope["B"] ];
d.sd.out.PutF["%lLogging%l: Toggle whether or not lines scrolled off top are written to the transcript.\n", IO.rope["b"], IO.rope["B"] ];
d.sd.out.PutF["%lLog%l: Toggle whether or not the transcript is visible.\n", IO.rope["b"], IO.rope["B"] ];
d.sd.out.PutF["%lSetLogLines%l: Set number of lines in transcript to number in selection, taking space from the terminal, if needed (but see about shift-clicking below). With no selection, fit transcript to unused space in the current viewer.\n", IO.rope["b"], IO.rope["B"] ];
d.sd.out.PutFL["%lSetLines%l, %lSetColumns%l: Set number of lines(columns) in terminal to number in selection. If the terminal won't fit in the viewer, the bottom of the terminal will be clipped (but see about shift-clicking below). With no selection, fit lines(columns) to current viewer\n", LIST[IO.rope["b"], IO.rope["B"], IO.rope["b"], IO.rope["B"]] ];
d.sd.out.PutF["%lGrab%l: Copy current selection to terminal as if typed in.\n", IO.rope["b"], IO.rope["B"] ];
d.sd.out.PutF["\n%lShift-clicking%l a Set... button or the Log button performs the given action, but then changes the containing viewer's size to fit both the transcript and terminal.\n", IO.rope["i"], IO.rope["I"] ];
};
-- Arbitrary limits
MaxLinesAllowed: INT ¬ 300;  
MaxColumnsAllowed: INT ¬ 300;
SetLinesMenuProc: Menus.MenuProc ~ {
d: SDViewerData ¬ NARROW[clientData];
null, ok: BOOLEAN; i: INT;
[ nullSelection: null, ok: ok, i: i ] ¬ ReadIntSelection[ 0 ];
IF null OR ok THEN {det: CharDisplays.DisplayDetails ¬ d.cd.det;
det.lines ¬ IF null THEN d.viewLines ELSE MIN[MaxLinesAllowed,i];
IF d.cd.client.InitiateChangeDetails[d.cd.client, d.cd, det] THEN {
IF shift THEN RepositionViewers[ d:d, force:shift ];
ComputeLinesInfo[ d ];  -- To update caption
ViewerOps.PaintViewer[d.topViewer, ViewerOps.PaintHint.all, TRUE, NIL];
};
}
};
SetColumnsMenuProc: Menus.MenuProc ~ {
d: SDViewerData ¬ NARROW[clientData];
null, ok: BOOLEAN; i: INT;
[ nullSelection: null, ok: ok, i: i ] ¬ ReadIntSelection[ 0 ];
IF null OR ok THEN {det: CharDisplays.DisplayDetails ¬ d.cd.det;
det.columns ¬ IF null THEN d.viewColumns ELSE MIN[MaxColumnsAllowed,i];
IF d.cd.client.InitiateChangeDetails[d.cd.client, d.cd, det] THEN {
IF shift THEN RepositionViewers[ d:d, force:shift ];
ComputeLinesInfo[ d ];  -- To update caption
ViewerOps.PaintViewer[d.topViewer, ViewerOps.PaintHint.all, TRUE, NIL];
};
}
};
SDChangeDetails: PUBLIC PROC [cd: CharDisplays.CharDisplay, new: CharDisplays.DisplayDetails] ~ {
sd: SimpleDisplayState = NARROW[cd.otherInstanceData];
IF new.autoMarginsVariable # cd.det.autoMarginsVariable OR new.scrollsVariable # cd.det.scrollsVariable THEN ERROR;
IF new.autoMargins # cd.det.autoMargins THEN {
IF NOT cd.det.autoMarginsVariable THEN ERROR;
cd.det.autoMargins ¬ new.autoMargins};
IF new.scrolls # cd.det.scrolls THEN {
IF NOT cd.det.scrollsVariable THEN ERROR;
cd.det.scrolls ¬ new.scrolls};
IF new.lines # cd.det.lines OR new.columns # cd.det.columns THEN {
ResizeTerminal[ cd, sd, new.lines, new.columns ];
};
};
Transcript Support
LogTranscriptLine: PUBLIC PROC [sd: SimpleDisplayState, chars: REF TEXT] ~ {
d: SDViewerData ¬ NARROW[sd.sdvData];
chars.length ¬ 0;
FOR j: INT DECREASING IN [0 .. chars.maxLength) DO
IF chars[j] # Ascii.SP THEN { chars.length ¬ j+1; EXIT }
ENDLOOP;
TypeScript.ChangeLooks[ d.tViewer, 'f ];
TypeScript.PutText[ d.tViewer, chars ];
TypeScript.PutText[ d.tViewer, "\n" ];
};
Initialize this viewer class
ViewerOps.RegisterViewerClass[
$SimpleDisplaysViewer,
NEW[ViewerClasses.ViewerClassRec ¬ [
paint: PaintSimpleDisplaysViewer,
notify: NotifySimpleDisplaysViewer,
modify: ModifySimpleDisplaysViewer,
adjust: AdjustSimpleDisplaysViewer
,tipTable: TIPUser.InstantiateNewTIPTable["SimpleDisplays.tip"]
]]
];
END.