sjs@jcricket.ctt.bellcore.com (Stan Switzer) (09/28/88)
After posting KeySee it occurred to me that it could just as well simulate input as monitor it. The following slightly modified version allows you to "type" using your mouse (of course you'll have to use "click-to-type" mode to make use of this feature). In order to make it possible to enter shifted keys, the left shift, the left meta and the control key are "sticky": one click is down, another is up. Please be aware that pressing the KeySee shift "button" affects your real keyboard as well as your virtual keyboard. Again, it will need some modification to work correctly for non Sun-3 style keyboards. Enjoy, Stan Switzer sjs@ctt.bellcore.com P.S. It is interesting to see how many simultaneous down keys can be detected. It is also interesting how "L1" works. Note that "Alt" is known to NeWS as "F10". --------------------------------------------------------------------- #!/usr/NeWS/bin/psh % % KeySee: % Display the keyboard and simulate keyboard input. % % Copyright (C) 1988 by Stan Switzer. All rights reserved. % This program is provided for unrestricted use, provided that this % copyright message is preserved. There is no warranty, and no author % or distributer accepts responsibility for any damage caused by this % program. % /KeyItem LabeledItem dictbegin /ItemDownColor .5 .5 .5 rgbcolor def /ItemRadius 4 def /Station null def /StickyKey? false def /ItemValue false def dictend classbegin /new { % label canvas width height => instance () /Center nullproc 6 3 roll /new super send begin ItemLabel /OU eq { % over/under key label /LowerLabel exch def /UpperLabel exch def } if currentdict end } def /ItemLabelFont /Times-Roman findfont 10 scalefont def /SetKeyValue { % bool => - -- true == down, false == up /ItemValue exch store ItemValue ItemPaintedValue ne {/paint self send} if } def /JustSetKeyValue { % bool => - -- true == down, false == up /ItemValue exch store } def /KS 2 def /PaintItem { ItemRadius KS 2 idiv dup ItemWidth KS sub ItemHeight KS sub rrectpath gsave ItemFillColor ItemValue null ne { ItemValue { pop ItemDownColor } if } if setcolor fill grestore ItemBorderColor setcolor stroke ShowLabel } def /OU { % over-under proc % if the Label is a proc, it is executed passing "true" to draw it % and "false" to return the width and height. % Hack: we pretend that the labels have no width and then % cshow them. { % draw it 0 currentfont fontdescent 2 idiv rmoveto gsave 0 currentfont fontheight rmoveto UpperLabel cshow grestore LowerLabel cshow } { 0 currentfont fontheight 2 mul } ifelse } def /reshape { % x y w h /reshape super send LabelSize % w h ItemHeight exch sub 2 div /LabelY exch def ItemWidth exch sub 2 div /LabelX exch def } def /SetStation { % stationcode => - 16#6F00 add % This is magic /Station exch def } def /ClientDown { true FakeKey } def /ClientUp { false FakeKey } def /FakeKey { StickyKey? { dup { /ItemValue ItemValue not store } if } { /ItemValue exch store true } ifelse { createevent dup begin /Name Station def /Action ItemValue /DownTransition /UpTransition ifelse def end sendevent } if } def /SetSticky { /StickyKey? exch def } def classend def /DummyKeyItem KeyItem [ ] classbegin /new { % canvas width height => instance () 4 1 roll /new super send } def /PaintItem { } def /SetStation { pop } def classend def /KeeSee DefaultWindow dictbegin /Items null def /ItemList null def /TmpDict null def /Watcher null def /IconKey null def /ItemProc null def dictbegin dictend classbegin /new { /new super send begin /PaintClient { ClientFillColor fillcanvas ClientCanvas setcanvas ItemList { paintitems } forall } def /TmpDict 20 dict def currentdict end } def /FrameLabel (Key See) def /IconLabel FrameLabel def /KeyWidth 24 def % Width (&Height) of Std Key /Border 4 def % border around keyboard proper /Key { % (Label) WidthFactor => item KeyWidth mul ClientCanvas exch KeyWidth /new KeyItem send pause } def /Dummy { % WidthFactor => item KeyWidth mul ClientCanvas exch KeyWidth /new DummyKeyItem send } def /Sticky { % item => item true /SetSticky 2 index send } def /CreateClientCanvas { /CreateClientCanvas super send % various items: /Items dictbegin (A) 0 get 1 (Z) 0 get { 1 string dup 0 4 -1 roll put dup 1 string copy cvn exch 1 Key def } for /D1 (!)(1)/OU 1 Key def /D2 (@)(2)/OU 1 Key def /D3 (#)(3)/OU 1 Key def /D4 ($)(4)/OU 1 Key def /D5 (%)(5)/OU 1 Key def /D6 (^)(6)/OU 1 Key def /D7 (&)(7)/OU 1 Key def /D8 (*)(8)/OU 1 Key def /D9 (\()(9)/OU 1 Key def /D0 (\))(0)/OU 1 Key def /Caps (Caps) 1.25 Key def /Left (Left) 1.5 Key Sticky def /Space () 9 Key def /SPC (Space) 2.25 Key def 0 0 /move SPC send /Right (Right) 1.5 Key def /Alt (Alt) 1.75 Key def /LShift (Shift) 2.25 Key Sticky def /RShift (Shift) 1.75 Key def /LF (LF) 1 Key def /L-C (<)(,)/OU 1 Key def /G-P (>)(.)/OU 1 Key def /Q-S (?)(/)/OU 1 Key def /Ctl (Ctl) 1.75 Key Sticky def /C-S (:)(;)/OU 1 Key def /Q-Q (")(')/OU 1 Key def /Ret (Return) 2.25 Key def /Tab (Tab) 1.5 Key def /O-B ({)([)/OU 1 Key def /C-B (})(])/OU 1 Key def /Del (Del) 1.5 Key def /Esc (Esc) 1 Key def /U-D (_)(-)/OU 1 Key def /P-E (+)(=)/OU 1 Key def /V-B (|)(\\)/OU 1 Key def /T-Q (~)(`)/OU 1 Key def /F1 (F1) 1 Key def /F2 (F2) 1 Key def /F3 (F3) 2 Key def /F4 (F4) 2 Key def /F5 (F5) 2 Key def /F6 (F6) 2 Key def /F7 (F7) 2 Key def /F8 (F8) 1 Key def /F9 (F9) 1 Key def /BS (BS) 1 Key def /L1 (L1) 1 Key def /L2 (L2) 1 Key def /X1 .5 Dummy def /L3 (L3) 1 Key def /L4 (L4) 1 Key def /X2 .5 Dummy def /L5 (L5) 1 Key def /L6 (L6) 1 Key def /X3 .5 Dummy def /L7 (L7) 1 Key def /L8 (L8) 1 Key def /X4 .5 Dummy def /L9 (L9) 1 Key def /L10 (L10) 1 Key def /X5 .5 Dummy def /X0 2.5 Dummy def /X6 .5 Dummy def /R1 (R1) 1 Key def /R2 (R2) 1 Key def /R3 (R3) 1 Key def /X7 .5 Dummy def /R4 (R4) 1 Key def /R5 (R5) 1 Key def /R6 (R6) 1 Key def /X8 .5 Dummy def /R7 (R7) 1 Key def /R8 (R8) 1 Key def /R9 (R9) 1 Key def /X9 .5 Dummy def /R10 (R10) 1 Key def /R11 (R11) 1 Key def /R12 (R12) 1 Key def /X10 .5 Dummy def /R13 (R13) 1 Key def /R14 (R14) 1 Key def /R15 (R15) 1 Key def dictend store % Display order /ItemList Items begin [ % Key rows from bottom to top [ X0 119 Caps Left Space Right 19 Alt ] Station [ 95 L9 97 L10 X5 99 LShift Z X C V B N M L-C G-P Q-S RShift LF X10 112 R13 R14 R15 ] Station [ 72 L7 L8 X4 76 Ctl A S D F G H J K L C-S Q-Q 89 Ret X9 91 R10 R11 R12 ] Station [ 49 L5 51 L6 X3 53 Tab Q W E R T Y U I O P O-B C-B Del X8 68 R7 R8 R9 ] Station [ 25 L3 L4 X2 29 Esc D1 D2 D3 D4 D5 D6 D7 D8 D9 D0 U-D P-E 88 V-B 42 T-Q X7 45 R4 R5 R6 ] Station [ 1 L1 3 L2 X1 5 F1 F2 8 F3 10 F4 12 F5 14 F6 16 F7 F8 F9 43 BS X6 21 R1 R2 R3 ] Station ] end store /ItemProc Items forkitems store } def /PaintIconKey { % paints IconKey centered in icon IconKey null ne { { ItemHeight ItemWidth } IconKey send IconWidth exch sub 2 idiv exch IconHeight exch sub 2 idiv gsave translate /PaintItem IconKey send grestore } if } def /PaintIcon { gsave IconCanvas setcanvas IconFillColor fillcanvas IconBorderColor strokecanvas IconTextColor setcolor PaintIconKey PaintIconLabel grestore } def /flipiconic { /flipiconic super send Iconic? { painticon } if % update icon image } def /SetIconKey { gsave IconCanvas setcanvas IconKey null ne { % erase previous key image { ItemWidth ItemHeight } IconKey send IconWidth 2 index sub 2 idiv IconHeight 2 index sub 2 idiv moveto rect IconFillColor setshade fill } if JustSetIconKey IconTextColor setcolor PaintIconKey grestore } def /JustSetIconKey { Items begin dup Space eq { % normal space bar is too big! /ItemValue get SPC dup /ItemValue 4 -1 roll put } if end /IconKey exch def } def /watch { % start event loop Watcher null ne { Watcher killprocess } if /Watcher { createevent dup begin /Name dictbegin % dict: keycode => item Items { exch pop dup /Station get dup null eq { pop pop } { exch def } ifelse } forall dictend def /Priority 10 def end expressinterest { awaitevent begin % Note: Name is key item because of interest /Name dict pause % perhaps this will let us do real work first % "self /foo exch send" keeps the method compiler % from removing self send. This is important to that % when (Just)SetIconKey is invoked it will end up % setting IconKey in the object, not in the event. % failing to do this results in having the interest % (which is apparently reused for all keyboard events) % referencing an item and consequently its parent (the % ClientCanvas), causing the canvas to just stick around % forever. Probably defing bogus entries in events should % be an error. This was no fun to find. Action /DownTransition eq Iconic? { /JustSetKeyValue Name send Name self /SetIconKey exch send } { /SetKeyValue Name send Name self /JustSetIconKey exch send } ifelse end } loop } fork def } def /Station { % [ KeyItems-and-indexes ] => [ KeyItems ] % sets the station codes in the array's items. mark exch 0 exch { % [ item item ... n currentitem dup type /integertype eq { exch pop } { 2 copy /SetStation exch send exch 1 add } ifelse } forall pop ] } def /ShapeClientCanvas { % This is a real good way to position items! /ShapeClientCanvas super send Recalc % recalc layout params ClientCanvas setcanvas % now, move the items to their rightful places TmpDict begin /SepX 0 def /SepY 0 def /Y Border def ItemList { /X Border def /MaxH 0 def { X Y /move 3 index send /ItemHeight 1 index send dup MaxH gt { /MaxH exch def } { pop } ifelse /ItemWidth exch send X add SepX add /X exch store } forall /Y Y MaxH SepY add add def } forall end Watcher null eq { watch } if } def /placeit { % one click placement and sizing gsave fboverlay setcanvas getclick grestore BorderLeft BorderRight add 21 KeyWidth mul add Border 2 mul add BorderTop BorderBottom add 6 KeyWidth mul add Border 2 mul add 3 -1 roll 1 index sub 3 1 roll % % ulx uly w h => llx lly w h reshape } def /Recalc { % - => - -- recalculates various layout parameters % for when I decide to handle resizing! } def classend def /win framebuffer /new KeeSee send def /placeit win send /map win send % ---- anything after this line is not part of the program ----
sjs@jcricket.ctt.bellcore.com (Stan Switzer) (09/28/88)
I am *SO* embarrrassed. Previous versions of KeySee neglected to load "liteitem.ps" before using it. I always have "liteitem" based tools running, so the problem never hit me. Anyway, here is a "correct" version. I'd just post the fix, but there is a new feature as well: you can turn on or off the keyboard monitoring feature (since it is pretty slow on some machines) with a cycle button. Sorry for the wasted net bandwidth, but at least it's not as big as "hproff" :-) Brickbats and accolades to: Stan Switzer sjs@ctt.bellcore.com ---------------------------------------------------------- #!/usr/NeWS/bin/psh % % KeySee: % Display the keyboard and simulate keyboard input. % % Copyright (C) 1988 by Stan Switzer. All rights reserved. % This program is provided for unrestricted use, provided that this % copyright message is preserved. There is no warranty, and no author % or distributer accepts responsibility for any damage caused by this % program. % systemdict /Item known not { (NeWS/liteitem.ps) run } if /KeyItem LabeledItem dictbegin /ItemDownColor .5 .5 .5 rgbcolor def /ItemRadius 4 def /Station null def /StickyKey? false def /ItemValue false def dictend classbegin /new { % label canvas width height => instance () /Center nullproc 6 3 roll /new super send begin ItemLabel /OU eq { % over/under key label /LowerLabel exch def /UpperLabel exch def } if currentdict end } def /ItemLabelFont /Times-Roman findfont 10 scalefont def /SetKeyValue { % bool => - -- true == down, false == up /ItemValue exch store ItemValue ItemPaintedValue ne {/paint self send} if } def /JustSetKeyValue { % bool => - -- true == down, false == up /ItemValue exch store } def /KS 2 def /PaintItem { ItemRadius KS 2 idiv dup ItemWidth KS sub ItemHeight KS sub rrectpath gsave ItemFillColor ItemValue null ne { ItemValue { pop ItemDownColor } if } if setcolor fill grestore ItemBorderColor setcolor stroke ShowLabel } def /OU { % over-under proc % if the Label is a proc, it is executed passing "true" to draw it % and "false" to return the width and height. % Hack: we pretend that the labels have no width and then % cshow them. { % draw it 0 currentfont fontdescent 2 idiv rmoveto gsave 0 currentfont fontheight rmoveto UpperLabel cshow grestore LowerLabel cshow } { 0 currentfont fontheight 2 mul } ifelse } def /reshape { % x y w h /reshape super send LabelSize % w h ItemHeight exch sub 2 div /LabelY exch def ItemWidth exch sub 2 div /LabelX exch def } def /SetStation { % stationcode => - 16#6F00 add % This is magic /Station exch def } def /ClientDown { true FakeKey } def /ClientUp { false FakeKey } def /FakeKey { StickyKey? { dup { /ItemValue ItemValue not store } if } { /ItemValue exch store true } ifelse { createevent dup begin /Name Station def /Action ItemValue /DownTransition /UpTransition ifelse def end sendevent } if } def /SetSticky { /StickyKey? exch def } def classend def /DummyKeyItem KeyItem [ ] classbegin /new { % canvas width height => instance () 4 1 roll /new super send } def /PaintItem { } def /SetStation { pop } def classend def /OnOffItem CycleItem dictbegin /Station null def dictend classbegin /new { % notify can => instance /cycle [ (On) (Off) ] /Right 5 3 roll 0 0 /new super send } def /SetStation { pop } def classend def /KeeSee DefaultWindow dictbegin /Items null def /ItemList null def /TmpDict null def /Watcher null def /IconKey null def /ItemProc null def dictbegin dictend classbegin /new { /new super send begin /PaintClient { ClientFillColor fillcanvas ClientCanvas setcanvas ItemList { paintitems } forall } def /TmpDict 20 dict def currentdict end } def /FrameLabel (Key See) def /IconLabel FrameLabel def /KeyWidth 24 def % Width (&Height) of Std Key /Border 4 def % border around keyboard proper /Key { % (Label) WidthFactor => item KeyWidth mul ClientCanvas exch KeyWidth /new KeyItem send pause } def /Dummy { % WidthFactor => item KeyWidth mul ClientCanvas exch KeyWidth /new DummyKeyItem send } def /Sticky { % item => item true /SetSticky 2 index send } def /CreateClientCanvas { /CreateClientCanvas super send % various items: /Items dictbegin (A) 0 get 1 (Z) 0 get { 1 string dup 0 4 -1 roll put dup 1 string copy cvn exch 1 Key def } for /D1 (!)(1)/OU 1 Key def /D2 (@)(2)/OU 1 Key def /D3 (#)(3)/OU 1 Key def /D4 ($)(4)/OU 1 Key def /D5 (%)(5)/OU 1 Key def /D6 (^)(6)/OU 1 Key def /D7 (&)(7)/OU 1 Key def /D8 (*)(8)/OU 1 Key def /D9 (\()(9)/OU 1 Key def /D0 (\))(0)/OU 1 Key def /Caps (Caps) 1.25 Key def /Left (Left) 1.5 Key Sticky def /Space () 9 Key def /SPC (Space) 2.25 Key def 0 0 /move SPC send /Right (Right) 1.5 Key def /Alt (Alt) 1.75 Key def /LShift (Shift) 2.25 Key Sticky def /RShift (Shift) 1.75 Key def /LF (LF) 1 Key def /L-C (<)(,)/OU 1 Key def /G-P (>)(.)/OU 1 Key def /Q-S (?)(/)/OU 1 Key def /Ctl (Ctl) 1.75 Key Sticky def /C-S (:)(;)/OU 1 Key def /Q-Q (")(')/OU 1 Key def /Ret (Return) 2.25 Key def /Tab (Tab) 1.5 Key def /O-B ({)([)/OU 1 Key def /C-B (})(])/OU 1 Key def /Del (Del) 1.5 Key def /Esc (Esc) 1 Key def /U-D (_)(-)/OU 1 Key def /P-E (+)(=)/OU 1 Key def /V-B (|)(\\)/OU 1 Key def /T-Q (~)(`)/OU 1 Key def /F1 (F1) 1 Key def /F2 (F2) 1 Key def /F3 (F3) 2 Key def /F4 (F4) 2 Key def /F5 (F5) 2 Key def /F6 (F6) 2 Key def /F7 (F7) 2 Key def /F8 (F8) 1 Key def /F9 (F9) 1 Key def /BS (BS) 1 Key def /L1 (L1) 1 Key def /L2 (L2) 1 Key def /X1 .5 Dummy def /L3 (L3) 1 Key def /L4 (L4) 1 Key def /X2 .5 Dummy def /L5 (L5) 1 Key def /L6 (L6) 1 Key def /X3 .5 Dummy def /L7 (L7) 1 Key def /L8 (L8) 1 Key def /X4 .5 Dummy def /L9 (L9) 1 Key def /L10 (L10) 1 Key def /X5 .5 Dummy def /X0 2.5 Dummy def /X6 .5 Dummy def /R1 (R1) 1 Key def /R2 (R2) 1 Key def /R3 (R3) 1 Key def /X7 .5 Dummy def /R4 (R4) 1 Key def /R5 (R5) 1 Key def /R6 (R6) 1 Key def /X8 .5 Dummy def /R7 (R7) 1 Key def /R8 (R8) 1 Key def /R9 (R9) 1 Key def /X9 .5 Dummy def /R10 (R10) 1 Key def /R11 (R11) 1 Key def /R12 (R12) 1 Key def /X10 .5 Dummy def /R13 (R13) 1 Key def /R14 (R14) 1 Key def /R15 (R15) 1 Key def /X11 .5 Dummy def /OnOff { ItemValue 0 eq { /watch } { /stopwatch } ifelse ThisWindow send } ClientCanvas /new OnOffItem send def 0 0 /move OnOff send % needs to be put somewhere dictend store % Display order /ItemList Items begin [ % Key rows from bottom to top [ X0 119 Caps Left Space Right 19 Alt X11 OnOff ] Station [ 95 L9 97 L10 X5 99 LShift Z X C V B N M L-C G-P Q-S RShift LF X10 112 R13 R14 R15 ] Station [ 72 L7 L8 X4 76 Ctl A S D F G H J K L C-S Q-Q 89 Ret X9 91 R10 R11 R12 ] Station [ 49 L5 51 L6 X3 53 Tab Q W E R T Y U I O P O-B C-B Del X8 68 R7 R8 R9 ] Station [ 25 L3 L4 X2 29 Esc D1 D2 D3 D4 D5 D6 D7 D8 D9 D0 U-D P-E 88 V-B 42 T-Q X7 45 R4 R5 R6 ] Station [ 1 L1 3 L2 X1 5 F1 F2 8 F3 10 F4 12 F5 14 F6 16 F7 F8 F9 43 BS X6 21 R1 R2 R3 ] Station ] end store /ItemProc Items forkitems store } def /PaintIconKey { % paints IconKey centered in icon IconKey null ne { { ItemHeight ItemWidth } IconKey send IconWidth exch sub 2 idiv exch IconHeight exch sub 2 idiv gsave translate /PaintItem IconKey send grestore } if } def /PaintIcon { gsave IconCanvas setcanvas IconFillColor fillcanvas IconBorderColor strokecanvas IconTextColor setcolor PaintIconKey PaintIconLabel grestore } def /flipiconic { /flipiconic super send Iconic? { painticon } if % update icon image } def /SetIconKey { gsave IconCanvas setcanvas IconKey null ne { % erase previous key image { ItemWidth ItemHeight } IconKey send IconWidth 2 index sub 2 idiv IconHeight 2 index sub 2 idiv moveto rect IconFillColor setshade fill } if JustSetIconKey IconTextColor setcolor PaintIconKey grestore } def /JustSetIconKey { Items begin dup Space eq { % normal space bar is too big! /ItemValue get SPC dup /ItemValue 4 -1 roll put } if end /IconKey exch def } def /stopwatch { % stop event loop Watcher null ne { Watcher killprocess } if } def /watch { % start event loop stopwatch /Watcher { createevent dup begin /Name dictbegin % dict: keycode => item Items { exch pop dup /Station get dup null eq { pop pop } { exch def } ifelse } forall dictend def /Priority 10 def end expressinterest { awaitevent begin % Note: Name is key item because of interest /Name dict pause % perhaps this will let us do real work first % "self /foo exch send" keeps the method compiler % from removing self send. This is important to that % when (Just)SetIconKey is invoked it will end up % setting IconKey in the object, not in the event. % failing to do this results in having the interest % (which is apparently reused for all keyboard events) % referencing an item and consequently its parent (the % ClientCanvas), causing the canvas to just stick around % forever. Probably defing bogus entries in events should % be an error. This was no fun to find. Action /DownTransition eq Iconic? { /JustSetKeyValue Name send Name self /SetIconKey exch send } { /SetKeyValue Name send Name self /JustSetIconKey exch send } ifelse end } loop } fork def } def /Station { % [ KeyItems-and-indexes ] => [ KeyItems ] % sets the station codes in the array's items. mark exch 0 exch { % [ item item ... n currentitem dup type /integertype eq { exch pop } { 2 copy /SetStation exch send exch 1 add } ifelse } forall pop ] } def /ShapeClientCanvas { % This is a real good way to position items! /ShapeClientCanvas super send Recalc % recalc layout params ClientCanvas setcanvas % now, move the items to their rightful places TmpDict begin /SepX 0 def /SepY 0 def /Y Border def ItemList { /X Border def /MaxH 0 def { X Y /move 3 index send /ItemHeight 1 index send dup MaxH gt { /MaxH exch def } { pop } ifelse /ItemWidth exch send X add SepX add /X exch store } forall /Y Y MaxH SepY add add def } forall end Watcher null eq { watch } if } def /placeit { % one click placement and sizing gsave fboverlay setcanvas getclick grestore BorderLeft BorderRight add 21 KeyWidth mul add Border 2 mul add BorderTop BorderBottom add 6 KeyWidth mul add Border 2 mul add 3 -1 roll 1 index sub 3 1 roll % % ulx uly w h => llx lly w h reshape } def /Recalc { % - => - -- recalculates various layout parameters % for when I decide to handle resizing! } def classend def /win framebuffer /new KeeSee send def /placeit win send /map win send % ----- If anything follows this line it is not part of the program! -----