DIRECTORY
Commander, CommanderOps, Convert, Imager, ImagerBackdoor, ImagerColor, IO, Rope, Xl, XTk, XTkBitmapWidgets, XTkShellWidgets;

X11ForeignImageTest: CEDAR MONITOR
IMPORTS Commander, CommanderOps, Convert, Imager, ImagerBackdoor, ImagerColor, IO, Xl, Rope, XTkBitmapWidgets, XTkShellWidgets =
BEGIN

lastStream: IO.STREAM ¬ NIL;
lastContext: Imager.Context ¬ NIL;
lastWidget: XTk.Widget ¬ NIL;

Erase: PROC [] = {
Imager.SetColor[lastContext, Imager.MakeGray[0.1]];
Imager.MaskRectangleI[lastContext, 0, 0, 10000, 10000];
};

Paint: PROC [] = {
Imager.SetColor[lastContext, Imager.black];
Imager.MaskRectangleI[lastContext, 10, 0, 4, 10000];
Imager.SetStrokeWidth[lastContext, 2];
Imager.MaskVectorI[lastContext, 0, 0, 10000, 10000];
Imager.SetStrokeWidth[lastContext, 8];
Imager.MaskVectorI[lastContext, 20, 20, 100, 100];
Imager.SetColor[lastContext, ImagerColor.ColorFromRGB[[1.0, 0.0, 0.0]]]; --use color to expose whether actual context supports colors
Imager.SetStrokeWidth[lastContext, 10];
Imager.MaskVectorI[lastContext, 20, 100, 100, 20];
};

ApplicationReportNewSize: PROC [bitmapWidget: XTk.Widget, size: Xl.Size] = {
c: Imager.Context ¬ lastContext ¬ CreateContext[bitmapWidget];
IO.PutF[lastStream, "w: %g, h: %g\n", IO.int[size.width], IO.int[size.height]];
lastWidget ¬ bitmapWidget;
Erase[];
Paint[];
};

bitsPerPixel: NAT ¬ 0;

AllocateNewBitmap: PROC [bitmapWidget: XTk.Widget] = {
size: Xl.Size ~ bitmapWidget.actual.size;
XTkBitmapWidgets.CreateAndSetBitmap[widget: bitmapWidget, size: [s: size.height, f: size.width], bpp: bitsPerPixel]; 
--This will make a new backing bitmap; tell your clients that they ought to replace their old imager contexts
--widget
ApplicationReportNewSize[bitmapWidget, size];
};

BitmapEventHappened: XTkBitmapWidgets.BitmapEventProc = {
IF reason=destroyWindow THEN {
RETURN;
};
IF reason=createWindow OR reason=resize THEN {
AllocateNewBitmap[widget]; 
};
};

CreateContextWidget: PROC [windowId: CARD, server: REF ANY ¬ NIL] RETURNS [bitmapWidget: XTk.Widget] = {
foreignParent: Xl.Window ~ [[windowId]];
shellWidget: XTk.Widget ¬ XTkShellWidgets.CreateInteroperabilityShell[];  --creates data structures ready to graft on our stuff 
bitmapWidget ¬ XTkBitmapWidgets.CreateBitmapWidget[notify: BitmapEventHappened];
XTkShellWidgets.SetShellChild[shellWidget, bitmapWidget];
XTkShellWidgets.BindScreenShell[shellWidget, server, foreignParent];
XTkShellWidgets.RealizeShell[shellWidget];  
};

CreateContext: PROC [bitmapWidget: XTk.Widget] RETURNS [Imager.Context] = {
RETURN [XTkBitmapWidgets.CreateContext[bitmapWidget]];
};

BindWindow: Commander.CommandProc ~ {
arg: Rope.ROPE ¬ CommanderOps.NextArgument[cmd];
id: CARD;
SELECT TRUE FROM
Rope.Equal[arg, "-egret", FALSE] => {
bitsPerPixel ¬ 24;
arg ¬ CommanderOps.NextArgument[cmd];
};
Rope.Equal[arg, "-four", FALSE] => {
bitsPerPixel ¬ 4;
arg ¬ CommanderOps.NextArgument[cmd];
};
ENDCASE => bitsPerPixel ¬ 0;
id ¬ Convert.CardFromRope[arg ! Convert.Error => CommanderOps.Failed["need id"]];
lastStream ¬ cmd.out;
[] ¬ CreateContextWidget[id, NIL ! Xl.XError => CommanderOps.Failed[err.explanation]];
};

DebugErase: Commander.CommandProc ~ {
Erase[];
};

DebugPaint: Commander.CommandProc ~ {
Paint[];
};

DebugWriteInfo: Commander.CommandProc ~ {
r: Imager.Rectangle ¬ ImagerBackdoor.GetBounds[lastContext];
IO.PutF[cmd.out, "Bounds x: %g,  y:%g, ", IO.real[r.x], IO.real[r.y]];
IO.PutF[cmd.out, "w: %g,  h: %g\n", IO.real[r.w], IO.real[r.h]];
};

DebugPaintXDirect: Commander.CommandProc ~ {
w: Xl.Window ¬ lastWidget.window;
c: Xl.Connection ¬ lastWidget.connection;
gc: Xl.GContext ¬ Xl.MakeGContext[c, w];
screen: Xl.Screen ¬ lastWidget.screenDepth.screen;
size: Xl.Size ¬ lastWidget.actual.size;
Xl.SetGCForeground[gc, screen.blackPixel];
Xl.SetGCBackground[gc, screen.whitePixel];
Xl.SetGCFunction[gc, copy];
Xl.SetGCLineWidth[gc, 3];
Xl.DrawLine[c, w, [0, 0], [size.width, size.height], gc];
Xl.Flush[c];
IO.PutF[cmd.out, "Size w: %g,  h:%g\n", IO.int[size.width], IO.int[size.height]];
};

Commander.Register["X11ForeignImageCreate", BindWindow, "Show drawing into foreign x window"];
Commander.Register["X11ForeignImageErase", DebugErase, "Test for drawing into foreign x window"];
Commander.Register["X11ForeignImagePaint", DebugPaint, "Test for drawing into foreign x window"];
Commander.Register["X11ForeignImageInfo", DebugWriteInfo, "Test for drawing into foreign x window"];
Commander.Register["X11ForeignImageDirect", DebugPaintXDirect, "Test for drawing into foreign x window"];
END.


    
X11ForeignImageTest.mesa 
Copyright Ó 1993 by Xerox Corporation.  All rights reserved.
Christian Jacobi, October 22, 1993 5:15 pm PDT

This demonstrates how to create an imager context which paints into foreign X windows.. 
This is not a useful application in itself, but can be used for demo, or, code stealing. 
 
--"Erases" with a visible pattern (for debugging)
--Paint some pattern 
--This procedure represents the application which needs to know when to create new imager contexts.
--For debugging we paint a certain pattern
--Remark: bpp 0 causes XTkBitmapWidgets to choose a value  
--This also allocates a new bitmap on resize so the bitmap tracks the size of the widget
--But that is optional, the bitmap and the widget may differ in size 
--maybe you want to also notify your application?
--Main procedure, creating a window which supports an imager context.
--windowId: window to be used 
--server: X server to be used.  A rope specifying the name, an Xl.Connection, or, NIL.  A defaulted server will fall back to a long list of defaults, ending up with using the display environment variable 
--This imager context paints into the currently active backing bitmap.  It will continue painting int the same old backing bitmap even if the bitmapWidget would display another bitmap.  
--Main command exercising this package
--Explicitely paint the background for debugging
--Explicitely paint for debugging
--Write the imager bounds for debugging
--Direct X commands for drawing; this can expose whether the window is actually not clipped
Ê‹  •NewlineDelimiter
™ code™Kšœ
Ïeœ1™<K™.K™ K™XK™YK™—šÏk	˜	K˜|—J˜ šÏnœžœž˜"Kšžœy˜€—Kšž˜J˜ Kšœžœžœžœ˜Kšœžœ˜"Kšœžœ˜K˜ šŸœžœ˜K™1K˜3K˜7K˜K˜ —šŸœžœ˜K™K˜+K˜4K˜&K˜4K˜&K˜2KšœIÏc<˜…K˜'K˜2K˜—K˜ šŸœžœ.˜LK™cK™*K˜>Kšžœ$žœžœ˜OK˜K˜K˜K˜—K˜ Kšœžœ˜K˜ šŸœžœ˜6K˜)˜uKšœ œ ™;Kš m˜mKš œ˜—K˜-K˜—K˜ šŸœ&˜9K™XK™Ešžœžœ˜K™1Kšžœ˜K˜—šžœžœžœ˜.K˜K˜—K˜—K˜ šŸœžœžœ
žœžœžœžœ˜hK™EK™K™ÌK˜(KšœJ 6˜€K˜PJ˜9K˜DK˜,J˜J˜ —šŸœžœžœ˜KK™ºJšžœ0˜6J˜—J˜ šŸ
œ˜%K™&Kšœ
žœ"˜0Kšœž˜	šžœžœž˜šœžœ˜%K˜K˜%K˜—šœžœ˜$K˜K˜%K˜—Kšžœ˜—K˜QK˜Kšœžœ6˜VK˜K˜ —šŸ
œ˜%K™0K˜K˜K˜ —šŸ
œ˜%K™!K˜K˜K˜ —šŸœ˜)K™'K˜<Kšžœ(žœžœ˜FKšžœ"žœžœ˜@K˜K˜ —šŸœ˜,K™[K˜!K˜)K˜(K˜2K˜'K˜*K˜*K˜K˜K˜9K˜Kšžœ&žœžœ˜QK˜—K˜ K˜^K˜aK˜aK˜dK˜iJšžœ˜J˜ J˜ J˜ J˜ — …—    ¨  E  