XTkTIPTest.mesa
Copyright Ó 1988, 1989, 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, November 21, 1988 10:37:52 am PST
Christian Jacobi, July 13, 1992 4:39 pm PDT
DIRECTORY
Commander,
Imager,
ImagerBackdoor,
ImagerSample,
IO,
KeyMapping,
Vector2,
SF,
Xl,
XlBitmap,
XTk,
XTkBitmapWidgets,
XTkTIP,
XTkTIPSource,
XTkShellWidgets;
XTkTIPTest:
CEDAR
PROGRAM
IMPORTS Commander, Imager, ImagerBackdoor, ImagerSample, IO, KeyMapping, XlBitmap, XTkBitmapWidgets, XTkTIP, XTkTIPSource, XTkShellWidgets =
ctx: Imager.Context;
lastBitmap: XTk.Widget ¬ NIL;
lastStream: IO.STREAM ¬ NIL;
TipTestCommand: Commander.CommandProc ~ {
lastStream ¬ cmd.out;
CreateWidget[];
};
TipTestCommand2: Commander.CommandProc ~ {
lastStream ¬ cmd.out;
CreateWidget[TRUE];
};
TipTestPrintCommand: Commander.CommandProc ~ {
keyCodes: KeyMapping.KeyCodes;
mapping: KeyMapping.Mapping;
h: XTkTIPSource.TipSourceHandle;
IF lastBitmap=NIL THEN {msg ¬ "no lastBitmap"; RETURN};
h ¬ XTkTIPSource.GetTipSourceHandle[lastBitmap];
IF h=NIL THEN {msg ¬ "no XTkTIPSource.TipSourceHandle"; RETURN};
mapping ¬ XTkTIPSource.CurrentMapping[h];
IF mapping=NIL THEN {msg ¬ "no KeyMapping.Mapping"; RETURN};
keyCodes ¬ KeyMapping.KeyCodesFromKeySym[mapping, [65 <<A>>]];
IF keyCodes=NIL THEN {msg ¬ "no keyCodes"; RETURN};
IO.PutF1[cmd.out, "num: %g \n", IO.int[keyCodes.n]];
FOR n:
INT
IN [0..keyCodes.n)
DO
IO.PutF[cmd.out, " (%g [%g]) ", IO.int[ORD[keyCodes[n].keyCode]], IO.int[keyCodes[n].glyphIndex]];
ENDLOOP;
};
CreateWidget:
PROC [debug:
BOOL ¬
FALSE] = {
tipTable: XTkTIP.TIPTable ¬ XTkTIP.InstantiateNewTIPTable["XTkTIPTest.tip"];
bitmap: XTk.Widget ¬ lastBitmap ¬ XTkBitmapWidgets.CreateBitmapWidget[
widgetSpec: [geometry: [size: [200, 300], borderWidth: 1]],
notify: BitmapChanged
];
top: XTk.Widget ¬ XTkShellWidgets.CreateShell[
child: bitmap,
windowHeader: "test tip input"
];
XTkShellWidgets.SetFocusMethod[top, false, true];
IF ~debug
THEN
XTkTIP.Bind[widget: bitmap, tipTable: tipTable, eventProc: TipEventProc, yup: TRUE];
XTkShellWidgets.ForkRealizeShell[top];
};
TipEventProc: Xl.EventProcType = {
tipEvent: Xl.TipEvent ¬ NARROW[event];
checkAndIgnore: XTk.Widget ¬ NARROW[tipEvent.who];
pos: Xl.Point ¬ [0, 0];
FOR l:
LIST
OF
REF
ANY ¬ tipEvent.results, l.rest
WHILE l#
NIL
DO
WITH l.first
SELECT
FROM
p: XTkTIP.TIPScreenCoords => {pos.x ¬ p.mouseX; pos.y ¬ p.mouseY};
a:
ATOM =>
SELECT a
FROM
$blob => Imager.MaskVector[ctx, [pos.x-3, pos.y-3], [pos.x+3, pos.y+3]];
$foo => {
Imager.MaskVector[ctx, [pos.x, pos.y-3], [pos.x, pos.y+3]];
IF lastStream#NIL THEN IO.PutChar[lastStream, '*];
};
$dot => Imager.MaskRectangle[ctx, [pos.x, pos.y, 1, 1]];
ENDCASE => {};
ENDCASE => {};
ENDLOOP;
};
Repaint:
PROC [ct: Imager.Context] = {
r: Imager.Rectangle ¬ ImagerBackdoor.GetBounds[ct];
Imager.SetColor[ct, Imager.white];
Imager.MaskBox[ct, [0, 0, 1000, 1000]];
Imager.SetColor[ct, Imager.black];
Imager.MaskVector[ct, [r.x, r.y], [r.x+r.w, r.y+r.h]];
Imager.MaskVector[ct, [r.x+r.w, r.y], [r.x, r.y+r.h]];
};
BitmapChanged: XTkBitmapWidgets.BitmapEventProc = {
IF reason<=map
THEN {
w: INT ¬ widget.actual.size.width;
h: INT ¬ widget.actual.size.height;
bm: XlBitmap.Bitmap ¬ XlBitmap.Create[[h, w]];
XTkBitmapWidgets.SetBitmap[widget, bm];
-- XTkBitmapWidgets.CreateAndSetBitmap[widget, [widget.actual.size.height, widget.actual.size.width]];
ctx ¬ XTkBitmapWidgets.CreateContext[widget];
Repaint[ctx];
IF lastStream#NIL THEN IO.PutF[lastStream, "resized %g %g\n", IO.int[w], IO.int[h]];
ImagerSample.Fill[map: XlBitmap.GetSM[bm], box: [min: [10, 10], max: [25, 25]]];
};
};
Commander.Register["XTkTipTest", TipTestCommand, "Xl tip table test"];
Commander.Register["XTkTipTest2", TipTestCommand2, "Xl tip table test"];
Commander.Register["XTkTipTestPrint", TipTestPrintCommand, "Xl tip table test"];
END.