XlImplGC.mesa
Copyright Ó 1988, 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, April 7, 1988 2:01:36 pm PDT
Christian Jacobi, September 14, 1993 4:22 pm PDT
Willie-s, October 30, 1991 10:38 am PST
DIRECTORY
Basics, FinalizeOps, IO, RefText, Rope, Xl, XlDetails, XlEndianPrivate, XlGContextOps, XlGContextPrivate, XlPrivate, XlPrivateErrorHandling, XlPrivateResources, XlPrivateSplit, XlPrivateTypes;
XlImplGC:
CEDAR
MONITOR
LOCKS c USING c: Connection
IMPORTS Basics, FinalizeOps, IO, RefText, Rope, Xl, XlDetails, XlEndianPrivate, XlPrivate, XlPrivateErrorHandling, XlPrivateResources
EXPORTS Xl, XlPrivate, XlPrivateSplit, XlPrivateTypes, XlGContextOps
SHARES XlPrivateResources
~ BEGIN OPEN Xl, XlPrivate, XlGContextOps;
ConnectionPrivateImplRec: TYPE = XlPrivateTypes.ConnectionPrivateImplRec;
<<Xl.>>ConnectionPrivate: PUBLIC TYPE = ConnectionPrivateImplRec;
<<Xl.>>GContextRep: PUBLIC TYPE = XlGContextPrivate.GContextRec;
GContextRec: TYPE = XlGContextPrivate.GContextRec;
ContextValueUsed: TYPE = ContextValueKey[function..arcMode];
RaiseClientError:
PROC [c: Xl.Connection, what:
REF ¬
NIL] = {
IF what=NIL THEN what ¬ $XlImplGC;
XlPrivateErrorHandling.RaiseClientError[c, what];
};
Exported frome here to make local calls...
But belongs to utility module
BPut8: PUBLIC PROC [c: Connection, b: BYTE] = {IBPut8[c, b]};
BPut16: PUBLIC PROC [c: Connection, b: CARD16] = {IBPut16[c, b]};
BPut32: PUBLIC PROC [c: Connection, b: CARD32] = {IBPut32[c, b]};
BPutDrawable: PUBLIC PROC [c: Connection, d: Drawable] = {IBPut32[c, d.id]};
LowI16:
PROC [i:
INT]
RETURNS [
INT16] =
INLINE {
RETURN [LOOPHOLE[Basics.LowHalf[LOOPHOLE[i, CARD]], INT16]]
};
LowC16:
PROC [i:
INT]
RETURNS [
CARD16] =
INLINE {
RETURN [Basics.LowHalf[LOOPHOLE[i, CARD]]]
};
BPutPoint:
PUBLIC
PROC [c: Connection, p: Point] = {
IBPut16[c, LowC16[p.x]];
IBPut16[c, LowC16[p.y]];
};
BPutSize:
PUBLIC
PROC [c: Connection, s: Size] = {
IBPut16[c, LowC16[s.width]];
IBPut16[c, LowC16[s.height]];
};
BPutRect:
PUBLIC
PROC [c: Connection, p: Point, s: Size] = {
IBPut16[c, LowC16[p.x]];
IBPut16[c, LowC16[p.y]];
IBPut16[c, LowC16[s.width]];
IBPut16[c, LowC16[s.height]];
};
DPutBYTE:
PUBLIC
PROC [c: Connection, byte:
BYTE] ~ {
XlEndianPrivate.InlinePut8[c, byte];
};
IsGContext:
PUBLIC
PROC [x:
REF
ANY]
RETURNS [
BOOL] = {
RETURN [ISTYPE[x, REF GContextRec]]
};
NarrowGContext:
PUBLIC
PROC [x:
REF
ANY]
RETURNS [GContext] = {
RETURN [NARROW[x, REF GContextRec]]
};
TooLong: ERROR = CODE;
NewGContext:
PROC [c: Connection, drawable: Drawable]
RETURNS [gc:
REF GContextRec] ~ {
Creates gc and initializes fields to server initial values
cPriv: REF ConnectionPrivateImplRec ¬ c.cPriv;
gc ¬ NEW[GContextRec];
gc.owner ¬ cPriv.refRefSelf;
gc.drawable ¬ drawable;
gc.changed ¬ ALL[FALSE];
gc.value[function] ¬ 3;
gc.value[planeMask] ¬ LAST[CARD32];
gc.value[background] ¬ 1;
gc.value[capStyle] ¬ 1;
gc.value[arcMode] ¬ 1;
gc.value[graphicsExposures] ¬ 1;
gc.value[dashes] ¬ 4;
gc.server ¬ gc.value;
gc.serverKnown ¬ ALL[TRUE];
--The following is non default but saves many troubles.
gc.value[graphicsExposures] ¬ 0;
gc.changed[graphicsExposures] ¬ TRUE;
};
MakeGContext:
PUBLIC
PROC [c: Connection, drawable: Drawable]
RETURNS [gc:
REF GContextRep] ~ {
cPriv: REF ConnectionPrivateImplRec ~ c.cPriv;
gRef: REF GraphicsRepImpl ~ cPriv.graphicsRef;
gc ¬ NewGContext[c, drawable];
[] ¬ FinalizeOps.EnableFinalization[gc, gRef.finalizerCallQueue];
};
FlushGContext:
PUBLIC
PROC [gc:
REF GContextRec, drawable: Drawable, details: Details] ~ {
action: PROC [c: Connection] = {[] ¬ UseGContext[c, drawable, gc, details]};
IF gc.resourceID=0
OR gc.changed#
ALL[
FALSE]
THEN {
owner: Connection ¬ gc.owner;
IF owner#NIL THEN DoWithLocks[owner, action, details];
};
};
GCID:
PUBLIC
PROC [gc: GContext, flush:
BOOL]
RETURNS [id:
ID] = {
IF gc.resourceID=0
AND gc.drawable#nullDrawable
THEN FlushGContext[gc, nullDrawable, NIL]
ELSE IF flush THEN FlushGContext[gc, nullDrawable, NIL];
id ¬ gc.resourceID
};
ValidateGC:
PUBLIC
PROC [gc: GContext, value: ContextValueKey] = {
EntryValidateGC:
ENTRY
PROC [c: Connection, gc: GContext, value: ContextValueKey] = {
gc.changed[value] ¬ FALSE;
};
owner: Connection ¬ gc.owner;
IF owner#
NIL
THEN EntryValidateGC[owner, gc, value]
ELSE gc.changed[value] ¬ FALSE;
};
InvalidateGC:
PUBLIC
PROC [gc: GContext, value: ContextValueKey] = {
EntryInvalidateGC:
ENTRY
PROC [c: Connection, gc: GContext, value: ContextValueKey] = {
gc.changed[value] ¬ TRUE;
};
owner: Connection ¬ gc.owner;
IF owner#
NIL
THEN EntryInvalidateGC[owner, gc, value]
ELSE gc.changed[value] ¬ TRUE
};
SetMaskBits:
PROC [gc: GContext, mask: GCValueMask, val:
BOOL] = {
FOR i: ContextValueKey
IN ContextValueUsed
DO
IF mask[i] THEN gc.changed[i] ¬ val;
ENDLOOP
};
ValidateGCMask:
PUBLIC
PROC [gc: GContext, mask: GCValueMask] = {
Entry:
ENTRY
PROC [c: Connection, gc: GContext, mask: GCValueMask] = {
SetMaskBits[gc, mask, FALSE];
};
owner: Connection ¬ gc.owner;
IF owner#
NIL
THEN Entry[owner, gc, mask]
ELSE SetMaskBits[gc, mask, FALSE];
};
InvalidateGCMask:
PUBLIC
PROC [gc: GContext, mask: GCValueMask ¬
ALL[
TRUE]] = {
Entry:
ENTRY
PROC [c: Connection, gc: GContext, mask: GCValueMask] = {
SetMaskBits[gc, mask, TRUE];
};
owner: Connection ¬ gc.owner;
IF owner#
NIL
THEN Entry[owner, gc, mask]
ELSE SetMaskBits[gc, mask, TRUE];
};
NestedEntryUseGContext:
PRIVATE
PROC [c: Connection, drawable: Drawable, gc: GContext, partialDetails: Details]
RETURNS [id:
CARD32 ¬ 0] = {
multiple locks hold...
action:
PROC [c: Connection] = {
id ¬ UseGContext[c, drawable, gc, partialDetails];
InternalRoundTrip[c]; --must be out on server if used by other connection
};
DoWithLocks[c, action, partialDetails];
};
FastGCID:
PROC [gc:
REF GContextRec]
RETURNS [gcid:
CARD32] =
INLINE {
IF gc#NIL AND gc.changed=ALL[FALSE] THEN RETURN [gc.resourceID] ELSE RETURN [0]
};
FinalizeGC: FinalizeOps.FinalizeProc = {
FreeGC:
ENTRY
PROC [c: Connection, gcid:
ID] = {
ENABLE UNWIND => NULL; <<for real>>
IF gcid#0
AND Xl.Alive[c]
AND XlPrivateResources.ValidID[c, gcid]
THEN {
SimpleFeedback.Append[$debugx11, oneLiner, $ok, "finalizes a gc\n"];
BInit[c, 60, 0, 2];
BPut32[c, gcid];
[] ¬ XlPrivate.FinishWithDetailsNoErrors[c, XlDetails.ignoreErrors];
XlPrivateResources.InternalFreeResourceID[c, gcid];
};
};
gc: REF GContextRec ~ NARROW[object];
c: Connection ¬ gc.owner;
IF Xl.Alive[c] THEN FreeGC[c, gc.resourceID ! ANY => CONTINUE]
};
CollectGC: PUBLIC <<XlFinalizePrivate>> Xl.EventProcType = {
FreeGC: ENTRY PROC [c: Connection, gcid: ID] = {
IF gcid#0 AND Xl.Alive[c] AND XlPrivateResources.ValidID[c, gcid] THEN {
BInit[c, 60, 0, 2];
BPut32[c, gcid];
[] ¬ XlPrivate.FinishWithDetailsNoErrors[c, XlDetails.ignoreErrors];
XlPrivateResources.InternalFreeResourceID[c, gcid];
};
};
WITH clientData SELECT FROM
gc: REF GContextRec => {
c: Connection ¬ gc.owner;
IF Xl.Alive[c] THEN FreeGC[c, gc.resourceID]
}
ENDCASE => {};
};
UseGContext:
PUBLIC <<INTERNAL>>
PROC [c: Connection, drawable: Drawable, gc:
REF GContextRec, partialDetails: Details]
RETURNS [id:
CARD32 ¬ 0] ~ {
Does NOT raise inline errors
IF gc=
NIL
THEN {
--We wouldn't care failing the nasty drawing request,
--but we don't want to wedge the connection.
--Note that we don't enable finalization for this gc.
gc ¬ NewGContext[c, drawable];
};
id ¬ gc.resourceID;
IF id=0
OR gc.changed#
ALL[
FALSE]
THEN {
owner: Connection ¬ gc.owner;
safeChanged: GCValueMask ¬ gc.changed;
safeChanged2: GCValueMask ¬ safeChanged;
n: NAT ¬ 0; bitmask: CARD32 ¬ 0;
create: BOOL ~ id=0;
IF owner=NIL THEN RETURN;
[bitmask, n] ¬ CountAndSetMaskBits[safeChanged];
IF create
THEN {
IF drawable=nullDrawable
THEN {
drawable ¬ gc.drawable;
IF drawable=nullDrawable THEN drawable ¬ DefaultRoot[owner].drawable;
};
IF c # owner
THEN {
--shame on you
--Create the resource on the other handle, so it has the right owner
id ¬ NestedEntryUseGContext[owner, drawable, gc, partialDetails
!
ANY =>
GOTO Oops;
We are not allowed to raise erros. A zero gc will cause the following operation to cause an X error and is therefore ok here
];
RETURN [id];
};
id ¬ gc.resourceID ¬ XlPrivateResources.NewResourceID[owner
! ANY => GOTO Oops; --Not allowed to raise errors
];
BInit[c, 55--CreateGC--, 0, n+4];
BPut32[c, id];
BPutDrawable[c, drawable];
}
ELSE {
BInit[c, 56--ChangeGC--, 0, n+3];
IBPut32[c, id];
};
IBPut32[c, bitmask];
FOR key: ContextValueKey
IN ContextValueUsed
WHILE safeChanged#
ALL[
FALSE]
DO
IF safeChanged[key]
THEN {
IBPut32[c, gc.server[key] ¬ gc.value[key]];
safeChanged[key] ¬ FALSE;
gc.serverKnown[key] ¬ TRUE;
};
ENDLOOP;
IF safeChanged2[font]
THEN
gc.temporaryPreventGCFontRemote ¬ gc.temporaryPreventGCFontLocal;
gc.changed ¬ ALL[FALSE];
[] ¬ FinishWithPartialDetailsNoErrors[c, partialDetails];
};
EXITS Oops => RETURN [0]
};
ISetGContext:
PROC [gc: GContext, key: ContextValueKey, value:
CARD32] ~
INLINE {
--Inline for constant folding
--Order important as not monitored !
--Dont cache pixmaps as a change to the contents might not be seen by a server (it may make a copy)
gc.value[key] ¬ value;
IF gc.server[key]#value OR ~gc.serverKnown[key] OR key=stipple OR key=tile OR (key=clipMask AND value#0) THEN gc.changed[key] ¬ TRUE;
};
SetGContext:
PUBLIC
PROC [gc: GContext, key: ContextValueKey, value:
CARD32] ~ {
ISetGContext[gc, key, value]
};
SetGCFontData:
PROC [gc: GContext, font: Font, serverKnows:
BOOL] ~
INLINE {
id: ID ¬ Xl.FontId[font];
IF id=0 THEN ERROR;
ISetGContext[gc, font, id];
gc.temporaryPreventGCFontLocal ¬ font;
IF serverKnows
THEN {
gc.temporaryPreventGCFontRemote ¬ font;
gc.changed[font] ¬ FALSE;
gc.server[font] ¬ id;
gc.serverKnown[font] ¬ TRUE;
}
};
SetGCFont:
PUBLIC
PROC [gc: GContext, font: Font] ~ {
SetGCFontData[gc, font, FALSE];
};
SetGCFunction:
PUBLIC
PROC [gc: GContext, function: GCFunction] ~ {
ISetGContext[gc: gc, key: function, value: ORD[function]];
};
SetGCFillStyle:
PUBLIC
PROC [gc: GContext, fillStyle: GCFillStyle] ~ {
ISetGContext[gc: gc, key: fillStyle, value: ORD[fillStyle]];
};
SetGCTile:
PUBLIC
PROC [gc: GContext, tile: Pixmap] ~ {
ISetGContext[gc: gc, key: tile, value: PixmapId[tile]];
};
SetGCStipple:
PUBLIC
PROC [gc: GContext, stipple: Pixmap] ~ {
ISetGContext[gc: gc, key: stipple, value: PixmapId[stipple]];
};
SetGCClipMask:
PUBLIC
PROC [gc: GContext, clipMask: Pixmap ¬ nullPixmap] ~ {
ISetGContext[gc: gc, key: clipMask, value: PixmapId[clipMask]];
};
SetGCStippleOrigin:
PUBLIC
PROC [gc: GContext, origin: Point] ~ {
cardX: CARD32 ¬ LOOPHOLE[origin.x];
cardY: CARD32 ¬ LOOPHOLE[origin.y];
ISetGContext[gc: gc, key: tileStippleXOrigin, value: cardX];
ISetGContext[gc: gc, key: tileStippleYOrigin, value: cardY];
};
SetGCClipMaskOrigin:
PUBLIC
PROC [gc: GContext, origin: Point] ~ {
cardX: CARD32 ¬ LOOPHOLE[origin.x];
cardY: CARD32 ¬ LOOPHOLE[origin.y];
ISetGContext[gc: gc, key: clipXOrigin, value: cardX];
ISetGContext[gc: gc, key: clipYOrigin, value: cardY];
};
SetGCBackground:
PUBLIC
PROC [gc: GContext, background:
CARD32] ~ {
ISetGContext[gc: gc, key: background, value: background];
};
SetGCGrounds:
PUBLIC
PROC [gc: GContext, foreground, background:
CARD32] ~ {
ISetGContext[gc: gc, key: background, value: background];
ISetGContext[gc: gc, key: foreground, value: foreground];
};
SetGCForeground:
PUBLIC
PROC [gc: GContext, foreground:
CARD32] ~ {
ISetGContext[gc: gc, key: foreground, value: foreground];
};
SetGCPlaneMask:
PUBLIC
PROC [gc: GContext, planeMask:
CARD32] ~ {
ISetGContext[gc: gc, key: planeMask, value: planeMask];
};
SetGCLineWidth:
PUBLIC
PROC [gc: GContext, width:
INT] ~ {
card: CARD32 ~ LOOPHOLE[width];
IF card<LAST[CARD16] THEN ISetGContext[gc: gc, key: lineWidth, value: card];
};
SetGCLineStyle:
PUBLIC
PROC [gc: GContext, lineStyle: GCLineStyle] ~ {
ISetGContext[gc: gc, key: lineStyle, value: ORD[lineStyle]];
};
SetGCCapStyle:
PUBLIC
PROC [gc: GContext, capStyle: GCCapStyle] ~ {
ISetGContext[gc: gc, key: capStyle, value: ORD[capStyle]];
};
SetGCFillRule:
PUBLIC
PROC [gc: GContext, fillRule: GCFillRule] ~ {
ISetGContext[gc: gc, key: fillRule, value: ORD[fillRule]];
};
SetGCJoinStyle:
PUBLIC
PROC [gc: GContext, joinStyle: GCJoinStyle] ~ {
ISetGContext[gc: gc, key: joinStyle, value: ORD[joinStyle]];
};
SetGCArcMode:
PUBLIC
PROC [gc: GContext, arcMode: GCArcMode] ~ {
ISetGContext[gc: gc, key: arcMode, value: ORD[arcMode]];
};
SetGCSubWindowMode:
PUBLIC
PROC [gc: GContext, subwindowMode: GCSubWindowMode] ~ {
ISetGContext[gc: gc, key: subwindowMode, value: ORD[subwindowMode]];
};
BoolToX:
PROC [b:
BOOL]
RETURNS [
CARD32] =
INLINE {
RETURN [(IF b THEN 1 ELSE 0)]
};
SetGCGraphicsExposures:
PUBLIC
PROC [gc: GContext, graphicsExposures:
BOOL] ~ {
ISetGContext[gc: gc, key: graphicsExposures, value: BoolToX[graphicsExposures]];
};
CopyArea:
PUBLIC
ENTRY
PROC [c: Connection, src, dst: Drawable, srcP, dstP: Point, size: Size, gc: GContext, details: Details] ~ {
err: ErrorNotifyEvent;
gcid: CARD32 ¬ UseGContext[c, dst, gc, details];
TRUSTED {
ptr: LONG POINTER TO CopyAreaRequestType ¬ XlPrivate.BRequestWithBlock[c, 62, 7*4, 0];
ptr ¬ [
--eventual bounce fault before calling lock
opcode: 62,
unused: 0,
length: 7,
src: src,
dst: dst,
gcid: gcid,
srcx: LowI16[srcP.x],
srcy: LowI16[srcP.y],
dstx: LowI16[dstP.x],
dsty: LowI16[dstP.y],
width: LowC16[size.width],
height: LowC16[size.height]
];
};
err ¬ XlPrivate.FinishWithDetailsNoErrors[c, details];
IF err#NIL THEN RETURN WITH ERROR XError[err];
};
CopyPlaneRequestType:
TYPE =
MACHINE
DEPENDENT
RECORD [
opcode: BYTE ¬ 63,
unused: BYTE ¬ 0,
length: CARD16 ¬ 8,
src: Drawable,
dst: Drawable,
gcid: CARD32,
srcx: INT16,
srcy: INT16,
dstx: INT16,
dsty: INT16,
width: CARD16,
height: CARD16,
bitPlane: CARD32
];
CopyAreaRequestType:
TYPE =
MACHINE
DEPENDENT
RECORD [
opcode: BYTE ¬ 62,
unused: BYTE ¬ 0,
length: CARD16 ¬ 8,
src: Drawable,
dst: Drawable,
gcid: CARD32,
srcx: INT16,
srcy: INT16,
dstx: INT16,
dsty: INT16,
width: CARD16,
height: CARD16
];
CopyPlane:
PUBLIC
ENTRY PROC [c: Connection, src, dst: Drawable, srcP, dstP: Point, size: Size, gc: GContext, bitPlane:
CARD, details: Details] ~
TRUSTED {
err: ErrorNotifyEvent;
gcid: CARD32 ¬ UseGContext[c, dst, gc, details];
ptr: LONG POINTER TO CopyPlaneRequestType ¬ XlPrivate.BRequestWithBlock[c, 63, 8*4, 0];
ptr ¬ [
opcode: 63,
unused: 0,
length: 8,
src: src,
dst: dst,
gcid: gcid,
srcx: LowI16[srcP.x],
srcy: LowI16[srcP.y],
dstx: LowI16[dstP.x],
dsty: LowI16[dstP.y],
width: LowC16[size.width],
height: LowC16[size.height],
bitPlane: bitPlane
];
err ¬ XlPrivate.FinishWithDetailsNoErrors[c, details];
IF err#NIL THEN RETURN WITH ERROR XError[err];
};
FillRectangle:
PUBLIC
ENTRY PROC [c: Connection, drawable: Drawable, gc: GContext, pos: Point, size: Size, details: Details] ~ {
err: ErrorNotifyEvent;
gcid: CARD32 ¬ UseGContext[c, drawable, gc, details];
BInit[c, 70, 0, 5];
BPutDrawable[c, drawable];
BPut32[c, gcid];
BPutRect[c, pos, size];
err ¬ XlPrivate.FinishWithDetailsNoErrors[c, details];
IF err#NIL THEN RETURN WITH ERROR XError[err];
};
DrawLine:
PUBLIC
ENTRY PROC [c: Connection, drawable: Drawable, p1, p2: Point, gc: GContext, details: Details] ~ {
err: ErrorNotifyEvent;
gcid: CARD32 ¬ UseGContext[c, drawable, gc, details];
BInit[c, 65, 0, 5];
BPutDrawable[c, drawable];
BPut32[c, gcid];
BPutPoint[c, p1];
BPutPoint[c, p2];
err ¬ XlPrivate.FinishWithDetailsNoErrors[c, details];
IF err#NIL THEN RETURN WITH ERROR XError[err];
};
GraphicsRep: PUBLIC TYPE = GraphicsRepImpl;
BitNByteOrderCase: TYPE = {plain, bitsInByteSwapped, bytesSwapped, bothSwapped, notYetImplemented};
GraphicsRepImpl:
TYPE =
RECORD [
bitNByteOrderCase: BitNByteOrderCase ¬ plain,
maxBytesPerPiece: INT ¬ 0,
buffer: REF TEXT ¬ NIL,
finalizerCallQueue: FinalizeOps.CallQueue ¬ NIL
];
This ought to find its way into XlEndianPrivate
selfImageByteOrder: XlEndianPrivate.Endian ~ msbFirst;
Good guess mit sometimes wrong: XlEndianPrivate.communicationByteOrder
selfBitOrder: XlEndianPrivate.Endian ~ XlEndianPrivate.bitmapBitInByteOrder;
SetupGraphics:
PUBLIC
PROC [c: Connection] = {
--DrawImage
--Watch the code of DrawImage to check for the funny constants for bitNByteOrderCase
cPriv: REF ConnectionPrivateImplRec ~ c.cPriv;
gRef: REF GraphicsRepImpl ~ NEW[GraphicsRepImpl];
serverBitOrder: XlEndianPrivate.Endian ~
SELECT Info[c].bitmapFormatBitOrder
FROM
mostSignificant => msbFirst,
leastSignificant => lsbFirst,
ENDCASE => ERROR; --bad server
serverImageByteOrder: XlEndianPrivate.Endian ~
SELECT Info[c].imageByteOrder
FROM
msbFirst => msbFirst,
lsbFirst => lsbFirst,
ENDCASE => ERROR; --bad server
serverScanlineUnit: INT ~ Info[c].bitmapFormatScanlineUnit;
gRef.bitNByteOrderCase ¬ notYetImplemented;
IF serverScanlineUnit MOD 8 # 0 THEN ERROR; --bad server
SELECT selfImageByteOrder
FROM
msbFirst => {
SELECT selfBitOrder
FROM
msbFirst => {
--e.g self=Sun
SELECT serverImageByteOrder
FROM
msbFirst => {
SELECT serverBitOrder
FROM
msbFirst => {
--e.g. self=server=sun
gRef.bitNByteOrderCase ¬ plain
};
lsbFirst => {
--e.g. self=sun, server=?
SELECT serverScanlineUnit
FROM
8 => gRef.bitNByteOrderCase ¬ bitsInByteSwapped;
16 => gRef.bitNByteOrderCase ¬ bothSwapped;
32 => gRef.bitNByteOrderCase ¬ bothSwapped;
ENDCASE => ERROR; --bad server
};
ENDCASE => ERROR; --not possible
};
lsbFirst => {
SELECT serverBitOrder
FROM
msbFirst => {
--e.g. self=sun, server=?
SELECT serverScanlineUnit
FROM
8 => gRef.bitNByteOrderCase ¬ plain;
16 => gRef.bitNByteOrderCase ¬ bytesSwapped;
32 => gRef.bitNByteOrderCase ¬ bytesSwapped;
ENDCASE => ERROR; --bad server
};
lsbFirst => {
e.g.self=sun, server=Mips
gRef.bitNByteOrderCase ¬ bitsInByteSwapped;
};
ENDCASE => ERROR; --not possible
};
ENDCASE => ERROR; --not possible
};
lsbFirst => {
self = ?
ERROR; --NOT YET IMPL
};
ENDCASE => ERROR;--not possible
};
lsbFirst => {
SELECT selfBitOrder
FROM
msbFirst => {
self = ?
ERROR; --NOT YET IMPL
};
lsbFirst => {
--e.g self=Mips
SELECT serverImageByteOrder
FROM
msbFirst => {
SELECT serverBitOrder
FROM
msbFirst => {
--e.g self=Mips, server=sun
gRef.bitNByteOrderCase ¬ bitsInByteSwapped;
};
lsbFirst => {
SELECT serverScanlineUnit
FROM
8 => gRef.bitNByteOrderCase ¬ plain;
16 => gRef.bitNByteOrderCase ¬ bytesSwapped;
32 => gRef.bitNByteOrderCase ¬ bytesSwapped;
ENDCASE => ERROR; --bad server
};
ENDCASE => ERROR; --not possible
};
lsbFirst => {
SELECT serverBitOrder
FROM
msbFirst => {
SELECT serverScanlineUnit
FROM
8 => gRef.bitNByteOrderCase ¬ bitsInByteSwapped;
16 => gRef.bitNByteOrderCase ¬ bothSwapped;
32 => gRef.bitNByteOrderCase ¬ bothSwapped;
ENDCASE => ERROR; --bad server
};
lsbFirst => {
gRef.bitNByteOrderCase ¬ plain;
};
ENDCASE => ERROR; --not possible
};
ENDCASE => ERROR; --not possible
};
ENDCASE => ERROR; --not possible
};
ENDCASE => ERROR; --not possible
IF (gRef.bitNByteOrderCase=bitsInByteSwapped OR gRef.bitNByteOrderCase=bothSwapped) AND bSwap=NIL THEN InitBSwap[];
--
gRef.maxBytesPerPiece ¬ MIN[Info[c].maxRequestLengthBytes, 12000];
gRef.buffer ¬ NEW[TEXT[8]];
--Finalization of GC`s
gRef.finalizerCallQueue ¬ FinalizeOps.CreateCallQueue[FinalizeGC];
--
cPriv.graphicsRef ¬ gRef;
};
GetBuff:
PROC [gRef:
REF GraphicsRepImpl, leng:
INT]
RETURNS [
LONG
POINTER
TO Basics.RawBytes] =
INLINE {
IF gRef.buffer.maxLength<leng THEN gRef.buffer ¬ RefText.New[leng];
RETURN [ LOOPHOLE[LOOPHOLE[gRef.buffer, CARD]+UNITS[TEXT[0]]] ];
};
globalCheckByte1, globalCheckByte2:
BYTE ¬ 0;
--global to keep the optimizer honest and not removing the pointer tests.
KeepTheOptimizerHonest:
PROC []
RETURNS [
INT] = {
this data is not at all used...
RETURN [globalCheckByte1+globalCheckByte2];
};
bSwap:
REF
PACKED
ARRAY
BYTE
OF
BYTE ¬
NIL;
InitBSwap:
PROC = {
bSwap ¬ NEW[PACKED ARRAY BYTE OF BYTE];
FOR byte:
BYTE
IN
BYTE
DO
swapped: BYTE ¬ 0;
i: BYTE ¬ byte; x: BYTE ¬ 128;
FOR bit:
BYTE
IN [0..7]
DO
IF i MOD 2 # 0 THEN swapped ¬ swapped+x;
x ¬ x/2; i ¬ i/2;
ENDLOOP;
bSwap[byte] ¬ swapped;
ENDLOOP;
};
PutImageStartRequestType:
TYPE =
MACHINE
DEPENDENT
RECORD [
opcode: BYTE ¬ 72,
format: BYTE ¬ 0,
length: CARD16,
drawable: Drawable,
gcid: CARD32,
width: CARD16,
height: CARD16,
dstx: INT16,
dsty: INT16,
leftPad: BYTE,
depth: BYTE,
unused: CARD16 ¬ 0
];
PutImage:
PUBLIC
PROC [c: Connection, drawable: Drawable, gc: GContext, size: Size, dest: Point, base:
LONG
POINTER, offx, offy:
INT, scanLineBytes:
INT, bitsPerPixel:
NAT ¬ 1, details: Details] ~ {
This is worth optimizing!
Protected:
ENTRY
PROC [c: Connection] =
TRUSTED {
ENABLE {
UNWIND => NULL;
IO.Error, IO.EndOfStream, UNCAUGHT => GOTO oops;
};
Plain:
INTERNAL
PROC [] =
TRUSTED
INLINE {
IF transmitBytesPSL>400
THEN {
--For large scan-lines: directly
XlPrivate.ContinueDirectRequest[c];
IF scanLineBytes=transmitBytesPSL
AND fillerBytes=0
AND skipBytesPSL=0
THEN {
--optimization case, e.g. when downloading fonts on a local machine
count: INT ~ transmitBytesPSL*size.height;
IO.UnsafePutBlock[c.xmit, [base: base, count: count]];
c.bufSkipped ¬ c.bufSkipped+count;
base ¬ base + hostUnitsPerScanLine*size.height;
}
ELSE {
--normal case
FOR height:
INT
IN [0..size.height)
DO
IO.UnsafePutBlock[c.xmit, [base: base, startIndex: skipBytesPSL, count: usefulBytes]];
c.bufSkipped ¬ c.bufSkipped+usefulBytes;
IF fillerBytes>0
THEN {
IO.UnsafePutBlock[c.xmit, [base: LOOPHOLE[gRef.buffer], count: fillerBytes]];
c.bufSkipped ¬ c.bufSkipped+fillerBytes;
};
base ¬ base + hostUnitsPerScanLine;
ENDLOOP;
};
WHILE (n MOD 4) # 0 DO n ¬ n+1; [] ¬ DPutBYTE[c, 0] ENDLOOP;
}
ELSE {
--For small scan-lines: use buffer
toP: LONG POINTER;
bytes: INT ¬ size.height*transmitBytesPSL+PaddingBytes[n];
toIdx: CARD ¬ 0;
XlPrivate.FineAssertBuffer[c, bytes];
toP ¬ XlPrivate.BContinueWithBlock[c, bytes];
FOR height:
INT
IN [0..size.height)
DO
[] ¬ Basics.ByteBlt[
to: [blockPointer: toP, startIndex: toIdx, stopIndexPlusOne: toIdx+usefulBytes],
from: [blockPointer: base, startIndex: skipBytesPSL, stopIndexPlusOne: skipBytesPSL+usefulBytes]
];
toIdx ¬ toIdx + transmitBytesPSL;
base ¬ base + hostUnitsPerScanLine;
ENDLOOP;
};
};
BitsInByteSwapped:
INTERNAL
PROC [] =
TRUSTED {
NEEDS TO BE OPTIMIZED
buff: LONG POINTER TO Basics.RawBytes ¬ GetBuff[gRef, transmitBytesPSL];
XlPrivate.ContinueDirectRequest[c];
FOR height:
INT
IN [0..size.height)
DO
idx: INT ¬ 0;
p: LONG POINTER TO Basics.RawBytes ~ LOOPHOLE[base];
FOR i:
INT
IN [skipBytesPSL .. skipBytesPSL+usefulBytes)
DO
buff[idx] ¬ bSwap[p[i]]; idx ¬ idx+1;
ENDLOOP;
IO.UnsafePutBlock[c.xmit, [base: LOOPHOLE[buff], count: transmitBytesPSL]];
c.bufSkipped ¬ c.bufSkipped+transmitBytesPSL;
base ¬ base + hostUnitsPerScanLine;
ENDLOOP;
WHILE (n MOD 4) # 0 DO n ¬ n+1; [] ¬ DPutBYTE[c, 0] ENDLOOP;
};
BytesSwapped:
INTERNAL
PROC [] =
TRUSTED {
NEEDS TO BE OPTIMIZED
buff: LONG POINTER TO Basics.RawBytes ¬ GetBuff[gRef, transmitBytesPSL];
bytesPerServerUnit: NAT ~ serverBitsPerUnit/8;
XlPrivate.ContinueDirectRequest[c];
IF fillerBytes>0 THEN ERROR; --not yet impl; but we try whether memory is available...
FOR height:
INT
IN [0..size.height)
DO
idx: INT ¬ 0;
p: LONG POINTER TO Basics.RawBytes ~ LOOPHOLE[base];
b: INT ¬ transmitBytesPSL;
startIndex: INT ¬ skipBytesPSL; --well aligned!
WHILE b > 0
DO
startIndex ¬ startIndex + bytesPerServerUnit;
THROUGH [0 .. bytesPerServerUnit)
DO
buff[idx] ¬ p[startIndex ¬ startIndex-1]; idx ¬ idx+1;
ENDLOOP;
startIndex ¬ startIndex + bytesPerServerUnit;
b ¬ b - bytesPerServerUnit;
ENDLOOP;
IF b#0 THEN ERROR;
IO.UnsafePutBlock[c.xmit, [base: LOOPHOLE[buff], count: transmitBytesPSL]];
c.bufSkipped ¬ c.bufSkipped+transmitBytesPSL;
base ¬ base + hostUnitsPerScanLine;
ENDLOOP;
WHILE (n MOD 4) # 0 DO n ¬ n+1; [] ¬ DPutBYTE[c, 0] ENDLOOP;
};
BothSwapped:
INTERNAL
PROC [] =
TRUSTED {
NEEDS TO BE OPTIMIZED
buff: LONG POINTER TO Basics.RawBytes ¬ GetBuff[gRef, transmitBytesPSL];
bytesPerServerUnit: NAT ~ serverBitsPerUnit/8;
XlPrivate.ContinueDirectRequest[c];
IF fillerBytes>0 THEN ERROR; --not yet impl; but we try whether memory is available...
FOR height:
INT
IN [0..size.height)
DO
idx: INT ¬ 0;
p: LONG POINTER TO Basics.RawBytes ~ LOOPHOLE[base];
b: INT ¬ transmitBytesPSL;
startIndex: INT ¬ skipBytesPSL; --well aligned!
WHILE b > 0
DO
startIndex ¬ startIndex + bytesPerServerUnit;
THROUGH [0 .. bytesPerServerUnit)
DO
buff[idx] ¬ bSwap[p[startIndex ¬ startIndex-1]]; idx ¬ idx+1;
ENDLOOP;
startIndex ¬ startIndex + bytesPerServerUnit;
b ¬ b - bytesPerServerUnit;
ENDLOOP;
IF b#0 THEN ERROR;
IO.UnsafePutBlock[c.xmit, [base: LOOPHOLE[buff], count: transmitBytesPSL]];
c.bufSkipped ¬ c.bufSkipped+transmitBytesPSL;
base ¬ base + hostUnitsPerScanLine;
ENDLOOP;
WHILE (n MOD 4) # 0 DO n ¬ n+1; [] ¬ DPutBYTE[c, 0] ENDLOOP;
};
gcid: CARD32;
reqLength: INT ¬ 6+(n+3)/4;
err: ErrorNotifyEvent;
IF (gcid ¬ FastGCID[gc])=0 THEN gcid ¬ UseGContext[c, drawable, gc, details];
BEGIN
ptr: LONG POINTER TO PutImageStartRequestType ¬ XlPrivate.BRequestWithBlock[c, 72, 6*4, (reqLength-6)*4];
ptr ¬ [
opcode: 72,
format: ORD[bitmapFormat],
length: LowC16[reqLength],
drawable: drawable,
gcid: gcid,
width: LowC16[size.width],
height: LowC16[size.height],
dstx: LowI16[dest.x],
dsty: LowI16[dest.y],
leftPad: LOOPHOLE[leftPadBits, Basics.LongNumber].ll,
depth: LOOPHOLE[bitsPerPixel, Basics.LongNumber].ll,
unused: 0
];
END;
SELECT gRef.bitNByteOrderCase
FROM
plain => Plain[];
bitsInByteSwapped => BitsInByteSwapped[];
bytesSwapped => BytesSwapped[];
bothSwapped => BothSwapped[];
ENDCASE => ERROR;
err ¬ XlPrivate.FinishWithDetailsNoErrors[c, details];
IF err#NIL THEN RETURN WITH ERROR XError[err];
EXITS oops => {
err: REF Xl.EventRep.errorNotify ~ XlPrivateErrorHandling.NewErrorEvent[reply: NIL, connection: c];
err.errorKind ¬ requestFromDeadConnection;
RETURN WITH ERROR XError[err];
};
};
n: INT;
cPriv: REF ConnectionPrivateImplRec ~ c.cPriv;
gRef: REF GraphicsRepImpl ~ cPriv.graphicsRef;
bitmapFormat: Xl.BitmapFormat ~
IF bitsPerPixel=1
THEN (IF details#NIL AND details.specific=$ZPixmap THEN zPixmap ELSE bitmap) <<in the pad split server, bitmap will generate lots of superflous communications>>
ELSE zPixmap;
serverBitsPerUnit: INT ~ c.info.bitmapFormatScanlineUnit;
serverScanlinePad: INT ~ c.info.bitmapFormatScanlinePad;
leftPadBits: INT ~ (offx*bitsPerPixel) MOD serverBitsPerUnit;
skipBytesPSL: INT ~ (offx*bitsPerPixel-leftPadBits) / 8; --per scan line
transmitBytesPSL: INT ~ (leftPadBits+size.width*bitsPerPixel+serverScanlinePad-1) / serverScanlinePad * serverScanlinePad / 8;
hostUnitsPerScanLine: INT ~ scanLineBytes * BYTES[UNIT];
usefulBytes: INT ¬ transmitBytesPSL;
fillerBytes: INT ¬ 0; --rare case when scanlines are be too short for transmission
IF skipBytesPSL+transmitBytesPSL > scanLineBytes
THEN {
fillerBytes ¬ skipBytesPSL+transmitBytesPSL-scanLineBytes;
usefulBytes ¬ transmitBytesPSL - fillerBytes;
};
IF scanLineBytes<=0 OR drawable=nullDrawable THEN RaiseClientError[c]; --funny caller
IF size.width<=0 OR size.height<=0 OR dest.x>LAST[INT16] THEN RETURN;
IF size.width>LAST[CARD16] OR size.height>LAST[CARD16] OR dest.x<0 OR dest.y<0 OR offx<0 OR offy<0 THEN RaiseClientError[c]; --funny caller
IF scanLineBytes MOD BYTES[UNIT] # 0 THEN RaiseClientError[c]; --callers error: scanline is not multiple of units
IF transmitBytesPSL>gRef.maxBytesPerPiece THEN RaiseClientError[c]; --too big
base ¬ base + offy*hostUnitsPerScanLine;
TRUSTED {
--check here to prevent address trap in monitored region
off: CARD32 ~ CARD32[size.height]*CARD32[hostUnitsPerScanLine];
b2: LONG POINTER ¬ LOOPHOLE[LOOPHOLE[base, CARD32] + off - 1];
IF (LAST[CARD32]-LOOPHOLE[base, CARD32]) <= off THEN ERROR; --area to large
globalCheckByte1 ¬ LOOPHOLE[base, LONG POINTER TO Basics.RawBytes][0];
globalCheckByte2 ¬ LOOPHOLE[b2, LONG POINTER TO Basics.RawBytes][0];
};
n ¬ transmitBytesPSL*size.height;
IF n<gRef.maxBytesPerPiece
THEN Protected[c]
ELSE {
--split requests into small parts...
maxHeight: INT ¬ gRef.maxBytesPerPiece/transmitBytesPSL;
restHeight: INT ¬ size.height;
size.height ¬ MIN[maxHeight, restHeight];
WHILE size.height>0
DO
n ¬ transmitBytesPSL*size.height;
IF dest.y>LAST[INT16] THEN RaiseClientError[c]; --too big
Protected[c];
dest.y ¬ dest.y+size.height;
restHeight ¬ restHeight-size.height;
size.height ¬ MIN[maxHeight, restHeight];
ENDLOOP;
}
};
maxGetImageSize:
INT = (
LAST[
NAT15]-32-8)/4;
-- LAST[NAT15] because of maximum TEXT size on dorado
-- -32 for fixed part of request
-- -8 reserve
-- -/4 in case of 32 bits per pixel
GetImage:
PUBLIC
PROC [c: Connection, drawable: Drawable, pos: Point, size: Size, format: PixmapFormat, planeMask:
CARD32 ¬
LAST[
CARD32]]
RETURNS [r: GetImageReplyRec] = {
reply: Reply;
action:
PROC [c: Connection] = {
BInit[c, 73, ORD[format], 5];
BPutDrawable[c, drawable];
BPutRect[c, pos, size];
BPut32[c, planeMask];
reply ¬ FinishWithReply[c];
};
leng: CARD;
IF size.width<=0 OR size.height<=0 THEN RaiseClientError[c, $ToSmall];
--? Split into multiple small requests ?
IF (maxGetImageSize / size.width) <= size.height THEN RaiseClientError[c, $ToLarge];
DoWithLocks[c, action, NIL];
CheckReply[reply];
r.anchor ¬ reply.varPart;
r.base ¬ LOOPHOLE[reply.varPart];
r.depth ¬ Read8[reply];
Skip[reply, 2];
leng ¬ ERead32[reply];
r.byteCount ¬ leng*4;
r.visual ¬ [ERead16[reply]];
reply.varPart ¬ NIL; --don't dispose varPart!-- DisposeReply[c, reply];
};
PutRectanglesDirect:
PROC [c: Connection, rects: PackedRects, start, num:
INT] =
TRUSTED {
cnt: INT ~ num*BYTES[PackedRectangle];
ContinueDirectRequest[c];
IO.UnsafePutBlock[c.xmit, [base: LOOPHOLE[@rects[start]], count: cnt]];
c.bufSkipped ¬ c.bufSkipped+cnt;
};
BPutRectangles:
PUBLIC PROC [c: Connection, rects: PackedRects, start, num:
INT] =
TRUSTED {
byteCnt: NAT ~ num*BYTES[Xl.PackedRectangle];
p: LONG POINTER ~ XlPrivate.BContinueWithBlock[c, byteCnt];
Basics.MoveWords[dst: p, src: LOOPHOLE[@rects[start]], count: byteCnt/BYTES[WORD]];
};
PolyFillRectangle:
PUBLIC
ENTRY PROC [c: Connection, drawable: Drawable, gc: GContext, rects: PackedRects, start:
NAT ¬ 0, number:
NAT ¬
LAST[
NAT], details: Details] = {
err: ErrorNotifyEvent;
total: INT ~ (IF rects#NIL THEN MIN[number, rects.numberOfRects-start] ELSE 0);
max: INT ~ MIN[Info[c].maxRequestLength/2, 200];
IF rects#
NIL
AND rects.numberOfRects>0
THEN {
gcid: CARD32 ¬ UseGContext[c, drawable, gc, details];
done: INT ¬ 0;
WHILE done<total
DO
thisTime: INT ¬ MIN[(total-done), max];
BInit[c, 70, 0, 3+2*thisTime];
BPutDrawable[c, drawable];
BPut32[c, gcid];
IF thisTime>100
THEN PutRectanglesDirect[c, rects, start+done, thisTime]
ELSE BPutRectangles[c, rects, start+done, thisTime];
err ¬ XlPrivate.FinishWithDetailsNoErrors[c, details];
IF err#NIL THEN RETURN WITH ERROR XError[err];
done ¬ done + thisTime;
ENDLOOP;
};
};
CountAndSetMaskBits:
PROC [mask: GCValueMask]
RETURNS [bitmask:
CARD¬0, n:
INT ¬ 0] = {
IF mask#
ALL[
FALSE]
THEN {
bit: CARD32 ¬ 1;
FOR key: ContextValueKey
IN ContextValueUsed
DO
IF mask[key] THEN {n ¬ n + 1; bitmask ¬ bitmask + bit};
bit ¬ bit + bit;
ENDLOOP
}
};
CopyGC:
PUBLIC
ENTRY PROC [c: Connection, srcGCID, destGCID:
ID, mask: GCValueMask, details: Details ¬
NIL] = {
err: ErrorNotifyEvent;
BInit[c, 57, 0, 4];
BPut32[c, srcGCID];
BPut32[c, destGCID];
BPut32[c, CountAndSetMaskBits[mask].bitmask];
err ¬ XlPrivate.FinishWithDetailsNoErrors[c, details];
IF err#NIL THEN RETURN WITH ERROR XError[err];
};
SetDashes:
PUBLIC
PROC [c: Connection, gc: GContext, dashOffset:
CARD16, dashes:
LIST
OF
BYTE, details: Details] = {
CountBytes:
PROC [list:
LIST
OF
BYTE]
RETURNS [cnt:
NAT ¬ 0] = {
maximum: INT ~ 100;
FOR l:
LIST
OF
BYTE ¬ list, l.rest
WHILE l#
NIL
AND cnt<maximum
DO
count ¬ count + 1
ENDLOOP;
};
count: NAT ¬ CountBytes[dashes];
action:
PROC [c: Connection] = {
gcid: CARD32 ¬ UseGContext[c, nullDrawable, gc, details];
BInit[c, 58, 0, 3+(count+3)/4];
BPut32[c, gcid];
BPut16[c, dashOffset];
BPut16[c, count];
FOR i:
INT
IN [0..count)
DO
next: LIST OF BYTE ¬ dashes.rest;
IBPut8[c, dashes.first];
IF next#NIL THEN dashes ¬ next;
ENDLOOP;
BSkip[c, PaddingBytes[count]];
FinishWithDetails[c, details];
};
IF count#0
THEN {
count ¬ MIN[count, c.info.maxRequestLength];
DoWithLocks[c, action, details];
};
};
SetClipRectangles:
PUBLIC
ENTRY PROC [c: Connection, gc: GContext, clipOrigin: Point ¬ [0, 0], rects: PackedRects, ordering: Ordering ¬ unSorted, start:
NAT ¬ 0, number:
NAT ¬
LAST[
NAT], details: Details]
RETURNS [ok:
BOOL ¬
TRUE] = {
total: INT ¬ (IF rects#NIL THEN MIN[number, rects.numberOfRects-start] ELSE 0);
max: INT ~ Info[c].maxRequestLength/2;
IF total>max THEN {ok ¬ FALSE; total ¬ max}; --check for maximum request length
IF total>0
THEN {
err: ErrorNotifyEvent;
gcid: CARD32 ¬ UseGContext[c, nullDrawable, gc, details];
BInit[c, 59, ORD[ordering], 3+2*total];
BPut32[c, gcid];
BPutPoint[c, clipOrigin];
IF total>100
THEN PutRectanglesDirect[c, rects, start, total]
ELSE BPutRectangles[c, rects, start, total];
err ¬ XlPrivate.FinishWithDetailsNoErrors[c, details];
IF err#NIL THEN RETURN WITH ERROR XError[err];
};
};
ImageChar:
PUBLIC
ENTRY PROC [c: Connection, drawable: Drawable, pos: Point, gc: GContext, ch:
CHAR, details: Details ¬
NIL] ~ {
err: ErrorNotifyEvent;
gcid: CARD32 ¬ UseGContext[c, drawable, gc, details];
BInit[c, 76, 1, 5];
BPutDrawable[c, drawable];
BPut32[c, gcid];
BPutPoint[c, pos];
IBPut8[c, ORD[ch]];
IBPut8[c, 0];
IBPut8[c, 0];
IBPut8[c, 0];
err ¬ XlPrivate.FinishWithDetailsNoErrors[c, details];
IF err#NIL THEN RETURN WITH ERROR XError[err];
};
ImageRope:
PUBLIC
ENTRY
PROC [c: Connection, drawable: Drawable, pos: Point, gc: GContext, r: Rope.
ROPE, details: Details] ~ {
err: ErrorNotifyEvent;
n: INT ¬ Rope.Length[r];
gcid: CARD32;
IF n>=LAST[BYTE] THEN RETURN WITH ERROR TooLong;
gcid ¬ UseGContext[c, drawable, gc, details];
BInit[c, 76, n, 4+(n+3)/4];
BPutDrawable[c, drawable];
BPut32[c, gcid];
BPutPoint[c, pos];
BPutPaddedRope[c, r];
err ¬ XlPrivate.FinishWithDetailsNoErrors[c, details];
IF err#NIL THEN RETURN WITH ERROR XError[err];
};
ToInt8Rep:
PROC [i:
INT]
RETURNS [
BYTE] = {
SELECT
TRUE
FROM
i>=0 AND i<128 => RETURN [i];
i<0 AND i>=-128 => RETURN [256+i];
ENDCASE => ERROR;
};
DrawChar:
PUBLIC
PROC [c: Connection, drawable: Drawable, pos: Point, gc: GContext, ch:
CHAR, delta:
INT ¬ 0, details: Details] ~ {
EntryDoit:
ENTRY
PROC [c: Connection] = {
err: ErrorNotifyEvent;
gcid: CARD32 ¬ UseGContext[c, drawable, gc, details];
BInit[c, 74, 0, 5];
BPutDrawable[c, drawable];
BPut32[c, gcid];
BPutPoint[c, pos];
IBPut8[c, 1]; --text length
IBPut8[c, ToInt8Rep[delta]];
IBPut8[c, ORD[ch]];
IBPut8[c, 0]; --padding
err ¬ XlPrivate.FinishWithDetailsNoErrors[c, details];
IF err#NIL THEN RETURN WITH ERROR XError[err];
};
IF delta
IN [-128..127]
THEN EntryDoit[c]
ELSE DrawRope[c, drawable, pos, gc, Rope.FromChar[ch], delta, details];
};
DrawRope:
PUBLIC
PROC [c: Connection, drawable: Drawable, pos: Point, gc: GContext, r: Rope.
ROPE, delta:
INT ¬ 0, details: Details] ~ {
leng: INT ¬ Rope.Length[r];
EnryDrawRope:
ENTRY PROC [c: Connection] = {
err: ErrorNotifyEvent;
gcid: CARD32 ¬ UseGContext[c, drawable, gc, details];
pieceStart: INT ¬ 0;
n: INT;
leng ¬ MIN[leng, Info[c].maxRequestLengthBytes/2]; --just be safe...
n ¬ ((leng+253) / 254)*2 + leng;
BInit[c, 74, 0, 4+(n+3)/4];
BPutDrawable[c, drawable];
BPut32[c, gcid];
BPutPoint[c, pos];
WHILE leng>0
DO
pieceLeng: INT ¬ MIN[leng, 254];
BPut8[c, pieceLeng];
BPut8[c, ToInt8Rep[delta]];
BPutRope[c, r, pieceStart, pieceLeng];
leng ¬ leng - pieceLeng;
pieceStart ¬ pieceStart + pieceLeng;
delta ¬ 0;
ENDLOOP;
BPut0s[c, PaddingBytes[n]];
--the protocol spec says pad must be 0 or 1 bytes
--Scheifler says: padding of 2 or 3 bytes must be done by inserting a zero item to ensure pad of 0 or 1 bytes
--ChJ: This is exactly the same thing as padding 0, 1, 2, or 3 bytes as long as pad bytes are 0
err ¬ XlPrivate.FinishWithDetailsNoErrors[c, details];
IF err#NIL THEN RETURN WITH ERROR XError[err];
};
IF leng>0
THEN {
IF delta
IN [-128..127]
THEN EnryDrawRope[c]
ELSE {
MyDeliver: Text8DeliverProc = {
text ¬ r; delta ¬ delta
};
PolyText8[c, drawable, pos, gc, MyDeliver, NIL, details];
}
};
};
AppendBigEndianCARD32:
PROC [t:
REF
TEXT, c:
CARD32]
RETURNS [
REF
TEXT] = {
Use this even in case of a little endian server! The protocol requests most significant font byte first.
f0, f1, f2, f3: BYTE;
f3 ¬ c MOD 256; c ¬ c /256;
f2 ¬ c MOD 256; c ¬ c /256;
f1 ¬ c MOD 256; c ¬ c /256;
f0 ¬ c MOD 256;
t ¬ RefText.AppendChar[t, VAL[f0]];
t ¬ RefText.AppendChar[t, VAL[f1]];
t ¬ RefText.AppendChar[t, VAL[f2]];
t ¬ RefText.AppendChar[t, VAL[f3]];
RETURN [t];
};
PolyText8:
PUBLIC
PROC [c: Connection, drawable: Drawable, pos: Point, gc: GContext, deliver: Text8DeliverProc, data:
REF ¬
NIL, details: Details] = {
EntryDoit:
ENTRY
PROC [c: Connection] = {
err: ErrorNotifyEvent;
gcid: CARD32 ¬ UseGContext[c, drawable, gc, details];
BInit[c, 74, 0, 4+(n+3)/4];
BPutDrawable[c, drawable];
BPut32[c, gcid];
BPutPoint[c, pos];
BPutRope[c, RefText.TrustTextAsRope[buffer], 0, RefText.Length[buffer]];
BPut0s[c, PaddingBytes[n]];
--the protocol spec says pad must be 0 or 1 bytes
--Scheifler says: padding of 2 or 3 bytes must be done by inserting a zero item to ensure pad of 0 or 1 bytes
--ChJ: This is exactly the same thing as padding 0, 1, 2, or 3 bytes as long as pad bytes are 0
err ¬ XlPrivate.FinishWithDetailsNoErrors[c, details];
IF lastOtherFont#
NIL
THEN {
SetGCFontData[gc, lastOtherFont, TRUE];
};
IF err#NIL THEN RETURN WITH ERROR XError[err];
};
maxLeng: INT ¬ MIN[Info[c].maxRequestLengthBytes - 100, Rope.TextBound.LAST];
buffer: REF TEXT ¬ RefText.ObtainScratch[RefText.page];
newFont: Xl.Font ¬ NIL;
firstOtherFont, lastOtherFont: Xl.Font ¬ NIL;
newFonts: LIST OF Xl.Font ¬ NIL; --prevents gc-ing of active fonts before the request is done. We do not optimize allocations for more then 1 font, as there is no imager request needing that.
delta: INT ¬ 0;
text: Rope.ROPE;
startPos, length, n: INT ¬ 0;
more: BOOL;
DO
[newFont: newFont, delta: delta, text: text, startPos: startPos, length: length, more: more] ¬ deliver[data];
IF newFont#
NIL
AND newFont#lastOtherFont
THEN {
id: Xl.ID ¬ Xl.FontId[newFont];
IF RefText.Length[buffer]>=(maxLeng-5) THEN EXIT;
IF id=0 THEN ERROR;
buffer ¬ RefText.AppendChar[buffer, VAL[255]];
buffer ¬ AppendBigEndianCARD32[buffer, id];
lastOtherFont ¬ newFont;
IF firstOtherFont=
NIL
THEN firstOtherFont ¬ newFont
ELSE newFonts ¬ CONS[newFont, newFonts];
};
length ¬ MIN[length, MAX[Rope.Length[text]-startPos, 0]];
WHILE delta > 127
DO
IF RefText.Length[buffer]>=(maxLeng-2) THEN EXIT;
buffer ¬ RefText.AppendChar[buffer, VAL[0]];
buffer ¬ RefText.AppendChar[buffer, VAL[127]];
delta ¬ delta-127;
ENDLOOP;
WHILE delta < -128
DO
IF RefText.Length[buffer]>=(maxLeng-2) THEN EXIT;
buffer ¬ RefText.AppendChar[buffer, VAL[0]];
buffer ¬ RefText.AppendChar[buffer, VAL[128]];
delta ¬ delta+128;
ENDLOOP;
IF length>0
OR delta#0
THEN {
DO
pieceLength: INT ¬ MIN[254, length];
IF RefText.Length[buffer]>=(maxLeng-pieceLength-2) THEN EXIT;
buffer ¬ RefText.AppendChar[buffer, VAL[pieceLength]];
buffer ¬ RefText.AppendChar[buffer, VAL[ToInt8Rep[delta]]];
buffer ¬ RefText.AppendRope[buffer, text, startPos, pieceLength];
startPos ¬ startPos + pieceLength;
length ¬ length - pieceLength;
IF length<=0 THEN EXIT;
delta ¬ 0;
ENDLOOP
};
IF ~more THEN EXIT;
ENDLOOP;
n ¬ RefText.Length[buffer];
IF n>0 THEN EntryDoit[c];
RefText.ReleaseScratch[buffer];
};
DrawString16:
PUBLIC
PROC [c: Connection, drawable: Drawable, pos: Point, gc: GContext, s: String16, delta:
INT ¬ 0, details: Details] ~ {
leng: INT ¬ Rope.Length[s];
EntryDoIt:
ENTRY
PROC [c: Connection] = {
err: ErrorNotifyEvent;
gcid: CARD32 ¬ UseGContext[c, drawable, gc, details];
pieceStart: INT ¬ 0;
n, len: INT;
len ¬ MIN[leng, Info[c].maxRequestLengthBytes/3]; --just be safe...
IF len MOD 2#0 THEN len ¬ len-1; --make it even
n ¬ ((len+507) / 508)*2 + len;
BInit[c, 75, 0, 4+(n+3)/4];
BPutDrawable[c, drawable];
BPut32[c, gcid];
BPutPoint[c, pos];
WHILE len>1
DO
--ignore an odd character
pieceLeng: INT ¬ MIN[len, 508]/2;
pieceLengBytes: INT ¬ pieceLeng*2;
BPut8[c, pieceLeng];
BPut8[c, ToInt8Rep[delta]];
BPutRope[c, s, pieceStart, pieceLengBytes];
len ¬ len - pieceLengBytes;
pieceStart ¬ pieceStart + pieceLengBytes;
delta ¬ 0;
ENDLOOP;
DPutPad[c, n];
--the protocol spec here is wrong [XlR2]
--Scheifler admits
--ChJ: It still doesn't make sense
--ChJ: this might or might not work, be aware when debugging
err ¬ XlPrivate.FinishWithDetailsNoErrors[c, details];
IF err#NIL THEN RETURN WITH ERROR XError[err];
};
IF delta>127 OR delta<-128 THEN ERROR; --Not impl, or, not part of the protocol
IF leng>0 THEN EntryDoIt[c];
};
ImageString16:
PUBLIC
ENTRY PROC [c: Connection, drawable: Drawable, pos: Point, gc: GContext, s: String16, details: Details] ~ {
n: INT ¬ Rope.Length[s.s];
IF n>=LAST[BYTE] THEN RETURN WITH ERROR TooLong;
IF n MOD 2 # 0 THEN RETURN WITH ERROR TooLong;
IF n>0
THEN {
err: ErrorNotifyEvent;
gcid: CARD32 ¬ UseGContext[c, drawable, gc, details];
BInit[c, 77, n/2, 4+(n+3)/4];
BPutDrawable[c, drawable];
BPut32[c, gcid];
BPutPoint[c, pos];
BPutPaddedRope[c, s.s];
err ¬ XlPrivate.FinishWithDetailsNoErrors[c, details];
IF err#NIL THEN RETURN WITH ERROR XError[err];
};
};
[] ¬ KeepTheOptimizerHonest[];
END.