XlTextWindowImpl.mesa
Copyright Ó 1988, 1989, 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Christian Jacobi, July 4, 1988 1:01:32 pm PDT
Christian Jacobi, March 24, 1992 3:42 pm PST
DIRECTORY
IO,
Ascii,
RefText,
Rope,
Xl,
XlCursor,
XlTextWindow;
XlTextWindowImpl:
CEDAR
MONITOR
IMPORTS IO, RefText, Rope, Xl, XlCursor
EXPORTS XlTextWindow =
BEGIN
OPEN Xl, XlTextWindow;
Failed: PUBLIC ERROR = CODE;
myPropKey: REF ATOM ¬ NEW[ATOM ¬ $XlTextWindowImpl];
events: EventFilter ~ CreateEventFilter[configureNotify, destroyNotify];
TextConnection: TYPE = REF TextConnectionRec;
TextConnectionRec:
TYPE =
MONITORED
RECORD [
tq: TQ ¬ NIL, --share the expose tq for texts of same connection
textCursor: Xl.Cursor ¬ nullCursor,
defaultFont: Font ¬ nullFont
];
InitConnection: InitializeProcType = {
tcr: TextConnection ¬ NEW[TextConnectionRec];
tcr.tq ¬ CreateTQ[$XlTextWindowImpl];
tcr.textCursor ¬ XlCursor.SharedStandardCursor[c, circle];
RETURN [tcr]
};
TextRecord:
TYPE =
MONITORED
RECORD [
connection: Xl.Connection ¬ NIL,
window: Window ¬ nullWindow,
wSize: 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: Point ¬ [0, 0], --position for next character; not yet clipped
font: Font ¬ nullFont,
gc: GContext ¬ NIL, --could we somehow share gc's?
alive: BOOL ¬ TRUE
];
SetWindowSize:
ENTRY
PROC [tRef:
REF TextRecord, s: Size] = {
IF tRef#NIL THEN tRef.wSize ¬ s
};
TextEventProc: EventProcType = {
ENABLE Xl.XError => GOTO oops;
tRef: REF TextRecord ~ NARROW[clientData];
WITH event
SELECT
FROM
destroyNotify: DestroyNotifyEvent => {
IF destroyNotify.window=tRef.window THEN tRef.alive ¬ FALSE
};
configureNotify: ConfigureNotifyEvent => {
IF configureNotify.window=tRef.window
THEN {
SetWindowSize[tRef, configureNotify.geometry.size];
};
};
mapNotify: MapNotifyEvent => {
IF mapNotify.window=tRef.window
THEN {
g: GeometryRec ¬ GetGeometry[event.connection, tRef.window];
SetWindowSize[tRef, g.geometry.size];
};
};
ENDCASE => {};
EXITS oops => {};
};
CreateTextHandle:
PUBLIC
PROC []
RETURNS [handle: Handle] = {
tRef: REF TextRecord ¬ NEW[TextRecord];
RETURN [tRef];
};
CreateTextWindow:
PUBLIC
PROC [handle: Handle, c: Connection, parent: Window, geometry: Geometry, font: Font ¬ nullFont, moreMatches: MatchList ¬
NIL, depth:
INTEGER ¬ -1, attributes: Attributes] = {
SetupFont:
PROC [tcr: TextConnection] = {
ENABLE UNWIND => NULL;
IF tcr.defaultFont=nullFont
THEN {
tcr.defaultFont ¬ Xl.OpenFont[c, "8x13"];
}
};
screen: Screen ¬ QueryScreen[c, parent];
tcr: TextConnection ¬ NARROW[GetConnectionPropAndInit[c, myPropKey, InitConnection]];
tRef: REF TextRecord ¬ NARROW[handle];
IF tRef.window#nullWindow THEN ERROR;
attributes.eventMask ¬ OREvents[attributes.eventMask, exposureMask, structureNotifyMask];
IF attributes.backgroundPixel=illegalPixel THEN attributes.backgroundPixel ¬ screen.whitePixel;
IF font=nullFont
THEN {
IF tcr.defaultFont=nullFont THEN SetupFont[tcr];
font ¬ tcr.defaultFont
};
tRef.connection ¬ c; tRef.font ¬ font;
Xl.IncRefCount[c, tRef];
SetWindowSize[tRef, geometry.size];
BEGIN
fi: REF READONLY FontInfoRec ¬ QueryFont[c, tRef.font];
tRef.ascent ¬ fi.fontAscent;
tRef.descent ¬ fi.fontDescent;
tRef.lineDY ¬ tRef.ascent+tRef.descent+tRef.lineSpace;
tRef.charDX ¬ fi.maxBounds.charWidth;
tRef.topOffset ¬ tRef.ascent+tRef.lineSpace;
tRef.bottomOffset ¬ tRef.descent+tRef.bottomSpace;
tRef.gc ¬ MakeGContext[c]; --should we share contexts of same parent???
SetGCForeground[tRef.gc, screen.blackPixel];
SetGCBackground[tRef.gc, screen.whitePixel];
SetGCFont[tRef.gc, font];
END;
HomePos[tRef];
moreMatches ¬
CONS[
NEW[MatchRep ¬ [proc: TextEventProc, handles: events, tq: tcr.tq, data: tRef]],
moreMatches
];
IF IllegalCursor[attributes.cursor] THEN attributes.cursor ¬ tcr.textCursor;
tRef.window ¬ CreateWindow[c: c, matchList: moreMatches, geometry: geometry, depth: depth, attributes: attributes, parent: parent];
tRef.alive ¬ TRUE;
};
ForgetWindow:
PUBLIC PROC [handle: Handle] = {
tRef: REF TextRecord ¬ NARROW[handle];
Xl.DecRefCount[tRef.connection, tRef];
tRef.alive ¬ FALSE;
tRef.connection ¬ NIL;
tRef.window ¬ Xl.nullWindow;
};
GetWindow:
PUBLIC
PROC [handle: Handle]
RETURNS [w: Xl.Window] = {
tRef: REF TextRecord ¬ NARROW[handle];
RETURN [tRef.window];
};
HomePos:
ENTRY
PROC [tRef:
REF TextRecord] = {
ENABLE UNWIND => NULL;
IF tRef#
NIL
THEN {
tRef.pos.x ¬ tRef.leftSpace;
tRef.pos.y ¬ tRef.topOffset;
};
};
PosAndIncrement:
ENTRY
PROC [tr:
REF TextRecord, rr:
INT]
RETURNS [pos: Point ¬ [0, 0]] = {
--increments position but returns previous value atomicly
ENABLE UNWIND => NULL;
IF tr#
NIL
THEN {
pos ¬ tr.pos;
tr.pos.x ¬ tr.pos.x+rr;
};
};
OutRope:
PUBLIC
PROC [handle: Handle, r: Rope.
ROPE, start:
INT ¬ 0, len:
INT ¬ Rope.MaxLen] = {
tRef: REF TextRecord ¬ NARROW[handle];
Action: Rope.ActionType = {UnflushedOutChar[tRef, c]};
IF tRef.window=nullWindow THEN RETURN;
[] ¬ Rope.Map[base: r, action: Action, len: len, start: start];
Flush[tRef.connection, 200];
};
OutChar:
PUBLIC
PROC [handle: Handle, ch:
CHAR] = {
tRef: REF TextRecord ¬ NARROW[handle];
IF tRef.window=nullWindow THEN RETURN;
UnflushedOutChar[tRef, ch];
Flush[tRef.connection, 200];
};
UnflushedOutChar:
PROC [tRef:
REF TextRecord, ch:
CHAR] = {
IF tRef.connection=NIL OR ~tRef.alive THEN RETURN;
IF ~tRef.alive THEN ERROR Failed;
SELECT ch
FROM
Ascii.
CR, Ascii.
LF => {
NewLine[tRef];
};
Ascii.
FF => {
HomePos[tRef];
ClearArea[tRef.connection, tRef.window, [0, 0], [2000, 2000], FALSE];
};
Ascii.NUL => {};
Ascii.
BS => {
tRef.pos.x ¬ MAX[tRef.pos.x-tRef.charDX, 0];
ClearArea[tRef.connection, tRef.window, [tRef.pos.x, MAX[tRef.pos.y, tRef.ascent]-tRef.ascent], [tRef.charDX, tRef.lineDY], FALSE];
};
ENDCASE => {
pos: Point;
IF INT[tRef.pos.x+tRef.charDX+tRef.rightSpace]>INT[tRef.wSize.width] AND tRef.pos.x>tRef.leftSpace THEN NewLine[tRef];
pos ¬ PosAndIncrement[tRef, tRef.charDX];
Xl.ImageChar[tRef.connection, tRef.window.drawable, pos, tRef.gc, ch];
};
};
NewLine:
PROC [tr:
REF TextRecord] = {
mustScroll: INT ¬ AdvanceLine[tr];
IF mustScroll>0
AND tr.alive
THEN {
y: INT;
--scrollup
Xl.CopyArea[c: tr.connection, src: tr.window.drawable, dst: tr.window.drawable, srcP: [0, mustScroll], dstP: [0, 0], size: [tr.wSize.width, tr.wSize.height-mustScroll], gc: tr.gc];
--clear bottom
y ¬ MAX[tr.pos.y, tr.ascent]-tr.ascent;
ClearArea[tr.connection, tr.window, [0, y], [2000, 2000]];
};
};
AdvanceLine:
ENTRY
PROC [tr:
REF TextRecord]
RETURNS [mustScroll:
INT¬0] = {
ENABLE UNWIND => NULL;
tr.pos.y ¬ tr.pos.y+tr.lineDY;
tr.pos.x ¬ tr.leftSpace;
IF
INT[tr.pos.y+tr.bottomOffset] >
INT[tr.wSize.height]
THEN {
mustScroll ¬ MIN[MAX[tr.wSize.height/4, tr.lineDY], tr.wSize.height];
tr.pos.y ¬ tr.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 Xl.XError, Failed => {ERROR IO.Error[StreamClosed, self]};
tRef: REF TextRecord = NARROW[self.streamData];
IF tRef.window=nullWindow THEN RETURN;
UnflushedOutChar[tRef, char];
Flush[tRef.connection, 200];
};
OutputTextWindowStreamPutBlock:
PROC [self:
IO.
STREAM, block:
REF
READONLY
TEXT, startIndex:
NAT, count:
NAT] = {
ENABLE Xl.XError, Failed => {ERROR IO.Error[StreamClosed, self]};
tRef: REF TextRecord = NARROW[self.streamData];
Action: PROC[c: CHAR] RETURNS [BOOL¬FALSE] = {UnflushedOutChar[tRef, c]};
IF tRef.window=nullWindow THEN RETURN;
[] ¬ RefText.Map[s: block, action: Action, len: count, start: startIndex];
Flush[tRef.connection, 200];
};
OutputTextWindowStreamEraseChar:
PROC [self:
IO.
STREAM, char:
CHAR] = {
OutputTextWindowStreamPutChar[self, Ascii.BS]
};
OutputStream:
PUBLIC
PROC [handle: Handle]
RETURNS [s:
IO.
STREAM] = {
RETURN[IO.CreateStream[streamProcs: outputStreamProcs, streamData: handle]];
};
END.