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 = BEGIN 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 <>]]; 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]; 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. >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 -- XTkBitmapWidgets.CreateAndSetBitmap[widget, [widget.actual.size.height, widget.actual.size.width]]; ÊÏ–(cedarcode) style•NewlineDelimiter ˜code™Kšœ ÏeœI™TKšœ;Ïk™>K™+—K˜šž ˜ K˜ K˜K˜Kšœ ˜ Kšœ˜Kšœ˜K˜Kšžœ˜Kšœ˜Kšœ ˜ K˜Kšœ˜K˜K˜ Kšœ˜—K˜šÏn œžœž˜Kšžœ…˜Œ—šž˜K˜—K˜Kšœžœ˜Kšœžœžœžœ˜K˜šŸœ˜)K˜K˜K˜K˜—šŸœ˜*K˜Kšœ žœ˜K˜K˜—šŸœ˜.Kšœ˜Kšœ˜Kšœ ˜ Kšžœžœžœžœ˜7K˜0Kšžœžœžœ+žœ˜@K˜)Kšžœ žœžœ!žœ˜Kšžœ žœžœžœ˜3Kšžœžœ˜4šžœžœžœž˜ Kšžœžœ žœ˜bKšžœ˜—Kšœ˜—K˜šŸœžœ žœžœ˜,KšœL˜LšœF˜FK˜;K˜K˜—šœ.˜.K˜K˜K˜—K˜1šžœžœ˜KšœNžœ˜T—Kšœ&˜&K˜—K˜šŸœ˜"Kšœžœ˜&Kšœžœ˜2K˜šžœžœžœžœžœžœžœž˜@šžœ žœž˜K˜Dšœžœžœž˜K˜H˜ K˜;Kšžœžœžœžœ˜2K˜—K˜8Kšžœ˜—Kšžœ˜—Kšžœ˜—K˜K˜—šŸœžœ˜&K˜3K˜"K˜'K˜"K˜6K˜6K˜K˜—šŸ œ&˜3šžœ žœ˜Kšœžœ˜"Kšœžœ˜#K˜.Kšœ'˜'Kšœf™fKšœ-˜-K˜ Kšžœžœžœžœ%žœ žœ ˜TKšœQ˜QK˜—K˜—K˜K˜FK˜HKšœP˜PKšžœ˜K˜—…— ÌÙ