[comp.windows.news] KeySee

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! -----