Path: utzoo!attcan!uunet!seismo!sundc!pitstop!sun!amdcad!ames!mailrus!tut.cis.ohio-state.edu!rutgers!bellcore!jcricket!sjs From: sjs@jcricket.ctt.bellcore.com (Stan Switzer) Newsgroups: comp.windows.news Subject: Re: KeySee (Update Again!): Stupid bug fix Message-ID: <10522@bellcore.bellcore.com> Date: 28 Sep 88 15:01:00 GMT References: <10498@bellcore.bellcore.com> <10519@bellcore.bellcore.com> Sender: news@bellcore.bellcore.com Reply-To: sjs@ctt.bellcore.com (Stan Switzer) Organization: Computer Technology Transfer, Bellcore Lines: 406 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! -----