DIRECTORY 
Ascii,
FanoutStream,
IO,
RefText,
Rope,
Xl,
XlCursor,
XlFontOps,
XTk,
XTkFriends,
XTkPrivate,
XTkStreamWidgets;

XTkStreamWidgetsImpl: CEDAR MONITOR 
IMPORTS FanoutStream, IO, RefText, Xl, XlCursor, XlFontOps, XTk, XTkFriends, XTkPrivate
EXPORTS XTkStreamWidgets =
BEGIN 

SetWindowSize: ENTRY PROC [oRef: REF OutputRec, s: Xl.Size] = {
IF oRef#NIL THEN oRef.wSize ¬ s
};

HomePos: ENTRY PROC [oRef: REF OutputRec] = {
IF oRef#NIL THEN {
oRef.pos.x ¬ oRef.leftSpace;
oRef.pos.y ¬ oRef.topOffset;
};
};

PosAndIncrement: ENTRY PROC [oRef: REF OutputRec, rr: INT] RETURNS [pos: Xl.Point ¬ [0, 0]] = {
IF oRef#NIL THEN {
pos ¬ oRef.pos; 
oRef.pos.x ¬ oRef.pos.x+rr;
};
};

UnflushedOutChar: PROC [oRef: REF OutputRec, ch: CHAR] = {
w: XTk.Widget ~ oRef.widget;
IF w.fastAccessAllowed#ok THEN RETURN;
SELECT ch FROM
Ascii.CR, Ascii.LF => {
NewLine[oRef];
};
Ascii.FF => {
HomePos[oRef];
Xl.ClearArea[w.connection, w.window, [0, 0], [2000, 2000], FALSE];
};
Ascii.NUL => {};
Ascii.BS => {
oRef.pos.x ¬ MAX[oRef.pos.x-oRef.charDX, 0];
Xl.ClearArea[w.connection, w.window, [oRef.pos.x, MAX[oRef.pos.y, oRef.ascent]-oRef.ascent], [oRef.charDX, oRef.lineDY], FALSE];
};
ENDCASE => {
pos: Xl.Point;
IF INT[oRef.pos.x+oRef.charDX+oRef.rightSpace]>INT[oRef.wSize.width] AND oRef.pos.x>oRef.leftSpace THEN NewLine[oRef];
pos ¬ PosAndIncrement[oRef, oRef.charDX];
Xl.ImageChar[w.connection, w.window.drawable, pos, oRef.gc, ch];
};
};

NewLine: PROC [oRef: REF OutputRec] = {
w: XTk.Widget ~ oRef.widget;
mustScroll: INT ¬ AdvanceLine[oRef];
IF mustScroll>0 AND w.fastAccessAllowed=ok THEN {
y: INT;
Xl.CopyArea[c: w.connection, src: w.window.drawable, dst: w.window.drawable, srcP: [0, mustScroll], dstP: [0, 0], size: [oRef.wSize.width, oRef.wSize.height-mustScroll], gc: oRef.gc];
y ¬ MAX[oRef.pos.y, oRef.ascent]-oRef.ascent;
Xl.ClearArea[w.connection, w.window, [0, y], [2000, 2000]];
};
};

AdvanceLine: ENTRY PROC [oRef: REF OutputRec] RETURNS [mustScroll: INT¬0] = {
oRef.pos.y ¬ oRef.pos.y+oRef.lineDY;
oRef.pos.x ¬ oRef.leftSpace;
IF INT[oRef.pos.y+oRef.bottomOffset] > INT[oRef.wSize.height] THEN {
mustScroll ¬ MIN[oRef.lineDY, oRef.wSize.height];
oRef.pos.y ¬ oRef.pos.y - mustScroll;
}
};

outputStreamProcs: REF IO.StreamProcs ¬ IO.CreateStreamProcs[
variety: $output, 
class: $XlTexts,
putChar: OutputTextWindowStreamPutChar,
putBlock: OutputTextWindowStreamPutBlock,
eraseChar: OutputTextWindowStreamEraseChar
];

OutputTextWindowStreamPutChar: PROC [self: IO.STREAM, char: CHAR] = {
ENABLE UNCAUGHT => GOTO Oops;
oRef: REF OutputRec ~ NARROW[self.streamData];
w: XTk.Widget ~ oRef.widget;
IF w.fastAccessAllowed#ok THEN RETURN;
UnflushedOutChar[oRef, char];
Xl.Flush[w.connection, TRUE];
EXITS Oops => {}
};

OutputTextWindowStreamPutBlock: PROC [self: IO.STREAM, block: REF READONLY TEXT, startIndex: NAT, count: NAT] = {
ENABLE UNCAUGHT => GOTO Oops;
oRef: REF OutputRec ~ NARROW[self.streamData];
w: XTk.Widget ~ oRef.widget;
Action: PROC[c: CHAR] RETURNS [BOOL¬FALSE] = {UnflushedOutChar[oRef, c]};
IF w.fastAccessAllowed#ok THEN RETURN;
[] ¬ RefText.Map[s: block, action: Action, len: count, start: startIndex];
Xl.Flush[w.connection, TRUE];
EXITS Oops => {}
};

OutputTextWindowStreamEraseChar: PROC [self: IO.STREAM, char: CHAR] = {
OutputTextWindowStreamPutChar[self, Ascii.BS]
};

outputClass: XTk.ImplementorClass ¬ XTkFriends.CreateClass[[key: $StreamWidget, wDataNum: 1, classNameHint: $Typescript, configureLR: Configure, initInstPart: StreamInitInstPart, forgetScreenLR: ForgetScreen]];

OutputRec: TYPE = RECORD [
widget: XTk.Widget, --backpointer for liveness
slave: IO.STREAM ¬ NIL,
font: Xl.Font ¬ Xl.nullFont,
wSize: Xl.Size ¬ [0, 0], --size of window
lineDY: INT ¬ 15, --distance between lines
leftSpace: NAT ¬ 2, --distance between left border and first character x origin
rightSpace: NAT ¬ 2, --distance between window right border and last characters right border
topOffset, bottomOffset: NAT ¬ 2, --distance between baseline and border
ascent, descent: NAT ¬ 2,
bottomSpace: NAT ¬ 2, 
charDX: NAT ¬ 10, 
lineSpace: NAT ¬ 2,
pos: Xl.Point ¬ [0, 0], --position for next character; not yet clipped
gc: Xl.GContext ¬ NIL --could we somehow share gc's?
];

GetOutputData: PROC [w: XTk.Widget] RETURNS [REF OutputRec] = INLINE {
RETURN [NARROW[XTkFriends.InstPart[w, outputClass]]];
};

NiceOpenFont: PROC [c: Xl.Connection, name: Rope.ROPE] RETURNS [Xl.Font ¬ Xl.nullFont] = {
font: Xl.Font;
IF Rope.IsEmpty[name] OR ~Xl.Alive[c] THEN RETURN;
font ¬ Xl.OpenFont[c, name, XTkPrivate.detailsForSynchronous ! Xl.XError => GOTO Oops];
RETURN [font];
EXITS Oops => {};
};

Configure: XTk.ConfigureProc = {
oRef: REF OutputRec ~ GetOutputData[widget];
existW: BOOL ¬ widget.actualMapping<unconfigured;
createW: BOOL ¬ mapping<unconfigured AND ~existW;
IF createW THEN {
IF Xl.IllegalCursor[widget.attributes.cursor] THEN 
widget.attributes.cursor ¬ XlCursor.SharedStandardCursor[widget.connection, circle];
IF widget.attributes.backgroundPixel=Xl.illegalPixel THEN 
widget.attributes.backgroundPixel ¬ widget.screenDepth.screen.whitePixel; 
IF widget.attributes.backingStore=illegal THEN 
widget.attributes.backingStore ¬ always; 
oRef.font ¬ NiceOpenFont[widget.connection, "8x13"];
IF oRef.font=Xl.nullFont THEN
oRef.font ¬ NiceOpenFont[widget.connection, "6x13"];
IF oRef.font=Xl.nullFont THEN {
oRef.font ¬ XlFontOps.GetDefaultFont[widget.connection];
};
BEGIN
fi: REF READONLY Xl.FontInfoRec ¬ Xl.QueryFont[widget.connection, oRef.font];
oRef.ascent ¬ fi.fontAscent;
oRef.descent ¬ fi.fontDescent;
oRef.lineDY ¬ oRef.ascent+oRef.descent+oRef.lineSpace;
oRef.charDX ¬ fi.maxBounds.charWidth;
oRef.topOffset ¬ oRef.ascent+oRef.lineSpace;
oRef.bottomOffset ¬ oRef.descent+oRef.bottomSpace;
oRef.gc ¬ Xl.MakeGContext[widget.connection]; --should we share contexts of same screen?
Xl.SetGCForeground[oRef.gc, widget.screenDepth.screen.blackPixel];
Xl.SetGCBackground[oRef.gc, widget.screenDepth.screen.whitePixel];
Xl.SetGCFont[oRef.gc, oRef.font];
END; 
HomePos[oRef];
};
XTkFriends.SimpleConfigureOneLevelLR[widget, geometry, mapping, reConsiderChildren];
IF existW OR createW THEN SetWindowSize[oRef, widget.actual.size]
};

ForgetScreen: XTk.TerminateProc = {
oRef: REF OutputRec ~ GetOutputData[widget];
oRef.font ¬ Xl.nullFont;
oRef.gc ¬ NIL;
};

StreamInitInstPart: XTk.InitInstancePartProc = {
oRef: REF OutputRec ~ NEW[OutputRec];
oRef.slave ¬ IO.CreateStream[streamProcs: outputStreamProcs, streamData: oRef];
oRef.widget ¬ widget;
XTkFriends.AssignInstPart[widget, outputClass, oRef];
};

CreateStreamWidget: PUBLIC PROC [widgetSpec: XTk.WidgetSpec ¬ [], widgetStream: IO.STREAM ¬ NIL] RETURNS [widget: XTk.Widget] = {
widget ¬ XTk.CreateWidget[widgetSpec, outputClass];
IF widgetStream#NIL THEN BindStream[widget, widgetStream];
};

CreateStream: PUBLIC PROC [w: XTk.Widget ¬ NIL] RETURNS [widgetStream: IO.STREAM] = {
widgetStream ¬ FanoutStream.Create[reportErrors: FALSE, forwardClose: FALSE];
IF w#NIL THEN BindStream[w, widgetStream];
};
BindStream: PUBLIC PROC [w: XTk.Widget, widgetStream: IO.STREAM] = {
oRef: REF OutputRec ~ GetOutputData[w];
FanoutStream.AddSlave[master: widgetStream, slave: oRef.slave];
};

END.

  0  
XTkStreamWidgetsImpl.mesa
Copyright س 1988, 1989, 1990, 1991, 1992 by Xerox Corporation.  All rights reserved.
Christian Jacobi, October 18, 1988 11:22:01 am PDT
Christian Jacobi, August 19, 1993 12:08 pm PDT

--increments position but returns previous value atomicly
--scrollup
--clear bottom
scrolling much has fallen in disfavor compared to scrolling a single line 
mustScroll ¬ MIN[MAX[oRef.wSize.height/4, oRef.lineDY], oRef.wSize.height];
--Oops, we should have a fix width font but this probably isn't.  I prefer bad looking text to crashing...

‌ت	¨  •NewlineDelimiter
–(cedarcode) style™ codeڑœ™Kڑœ
دeœI™TKڑœ2™2™.K™ ——ڑدk	œک
KڑœکKکKڑ‍œکKڑœکKڑœکKڑœکKڑœ	ک	Kک
KکKڑœکKکKڑœکKک —ڑدnœ‍œ‍œک$Kڑ‍œPکWKڑ‍œک—Kڑ‍œکKک ڑںœ‍œ‍œ‍œک?Kڑ‍œ‍œ‍œکKڑœک—Kک ڑںœ‍œ‍œ‍œک-ڑ‍œ‍œ‍œکKڑœکKڑœکKک—Kک—Kک ڑںœ‍œ‍œ‍œ‍œ‍œک_K™9ڑ‍œ‍œ‍œکKڑœکKڑœکKک—Kک—Kک ڑںœ‍œ‍œ‍œک:KڑœکKڑ‍œ‍œ‍œک&ڑ‍œ‍کڑœ‍œ‍œکKڑœکKڑœک—ڑœ‍œکKڑœکKڑœ;‍œکBKڑœک—Kڑœ‍œکڑœ‍œکKڑœ‍œک,Kڑœ2‍œD‍œک€Kڑœک—ڑ‍œکKڑœکKڑ
‍œ‍œ)‍œ‍œ‍œکvKڑœ)ک)Kڑœ@ک@Kک——Kک—Kک ڑںœ‍œ‍œک'KڑœکKڑœ‍œک$ڑ‍œ‍œ‍œک1Kڑœ‍œکKڑœ
™
Kڑœ·ک·Kڑœ™Kڑœ‍œ&ک-Kڑœ;ک;Kڑœک—Kک—Kک ڑںœ‍œ‍œ‍œ‍œ‍œکMKڑœ$ک$Kڑœکڑ‍œ‍œ!‍œ‍œکD™JKڑœ‍œ‍œ7™K—Kڑœ‍œ!ک1Kڑœ%ک%Kک—Kڑœک—Kک –"cedar" styleڑœ‍œ‍œ‍œک=K–"cedar" styleکK–"cedar" styleڑœکK–"cedar" styleڑœ'ک'K–"cedar" styleڑœ)ک)K–"cedar" styleڑœ*ک*K–"cedar" styleڑœک—Kک –"cedar" styleڑ
ںœ‍œ‍œ‍œ‍œکEKڑ‍œ‍œ‍œکKڑœ‍œ‍œک.KڑœکKڑ‍œ‍œ‍œک&KڑœکKڑœکK–"cedar" styleڑ‍œکK–"cedar" styleڑœکK–"cedar" styleک —–"cedar" styleڑںœ‍œ‍œ‍œ	‍œ‍œ‍œ‍œ	‍œکqKڑ‍œ‍œ‍œکKڑœ‍œ‍œک.KڑœکKڑںœ‍œ‍œ‍œ‍œ‍œ کIKڑ‍œ‍œ‍œک&KڑœJکJKڑœکK–"cedar" styleڑ‍œکK–"cedar" styleڑœکK–"cedar" styleک —ڑ
ںœ‍œ‍œ‍œ‍œکGKڑœ*‍œک-Kڑœک—Kک KڑœزکزKک ڑœ‍œ‍œکKڑœدcک.Kڑœ‍œ‍œ‍œکKڑœکKڑœ ک)Kڑœ‍œ ک*Kڑœ‍œ ;کOKڑœ‍œ Gک\Kڑœ‍œ &کHKڑœ‍œکKڑœ‍œکKڑœ‍œکKڑœ‍œکKڑœ .کFKڑœ‍œ ک4Kک—Kک ڑ
ںœ‍œ‍œ‍œ‍œکFKڑ‍œ‍œ'ک5Kڑœک—Kک ڑںœ‍œ‍œ‍œکZKکKڑ‍œ‍œ‍œ‍œک2KڑœL‍œکWKڑ‍œکKڑ‍œکKکKک —ڑں	œک Kڑœ‍œ#ک,Kڑœ‍œ%ک1Kڑœ	‍œ‍œ	ک1ڑ‍œ	‍œکڑ‍œ,‍œک3KڑœTکT—ڑ‍œ3‍œک:KڑœJکJ—ڑ‍œ(‍œک/Kڑœ)ک)—Kک4ڑ‍œ‍کKک4—ڑ‍œ‍œکK™jKک8Kک—ڑ‍کKڑœ‍œ‍œ=کMKڑœکKڑœکKڑœ6ک6Kڑœ%ک%Kڑœ,ک,Kڑœ2ک2Kڑœ. *کXKڑœBکBKڑœBکBKڑœ!ک!Kڑ‍œک—KڑœکKڑœک—KڑœTکTKڑ‍œ‍œ	‍œ(کAKک—Kک ڑںœک#Kڑœ‍œ#ک,KڑœکKڑœ
‍œکKڑœک—Kک ڑںœک0Kڑœ‍œ‍œک%Kڑœ‍œ@کOKڑœکKڑœ5ک5KکKک —ڑںœ‍œ‍œ1‍œ‍œ‍œ‍œکپKڑœ3ک3Kڑ‍œ‍œ‍œ"ک:Kڑœک—Kک ڑںœ‍œ‍œ‍œ‍œ‍œ‍œکUKڑœ1‍œ‍œکMKڑ‍œ‍œ‍œک*KکK™ —ڑ
ں
œ‍œ‍œ‍œ‍œکDKڑœ‍œک'Kک?Kک—Kک Kڑ‍œکKک — …—    ‏  'ض  