"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
Object subclass:#WindowSensor
instanceVariableNames:'eventSemaphore damage mouseAndKeyboard compressMotionEvents
ignoreUserInput exposeEventSemaphore catchExpose gotExpose
gotOtherEvent translateKeyboardEvents shiftDown ctrlDown metaDown
altDown leftButtonDown middleButtonDown rightButtonDown
eventListener keyboardListener'
classVariableNames:'ControlCEnabled EventListener ComposeTable GotCompose Compose1'
poolDictionaries:''
category:'Interface-Support'
!
!WindowSensor class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
Instances of this class keep track of events and damage areas for a group of
views. All incoming expose rectangles and events (from Workstation) are
collected here, until someone (usually the windowGroup process)
gets a chance to handle them.
In contrast to ST-80 (which has one windowSensor per window), ST/X usually
only assigns one sensor per windowGroup.
(however, you could manually arrange for per view private sensors
- at least, theoretically)
When adding an expose rectangle, WindowSensor tries to merge the rectangle
with the list of existing damages to minimize redrawing.
Processing of compose key sequences is done here; if a Compose
key event arrives, the following 2 characters are used to search an
entry in the composeTable, and are replaced by the character found there.
For example, pressing Compose-a-` gives the french a-accent-grave character;
pressing Compose-a-e gives the ae ligature.
Beside the above, windowSensors provide facilities (hooks) to allow
a so-called 'eventListener' to get the event before it is entered into
the queue. There are 3 possible listening hooks available:
a global EventListener - gets keybd/mouse events for all views
a per-sensor eventListener - gets only keybd/mouse events for this sensors wGroup
a per-sensor keyboardListener - only gets keyboard events for this sensors wGroup
(actually, there are two more mechanisms, event delegation which allows
delegation of key- and buttonEvents of a specific view,
and per-windowGroup eventHooks)
The global eventListener is installed via a class method (eventListener:) to
the WindowSensor class; local listeners are installed via instance methods.
Each listener should return true, if it handled the event and that event should
therefore NOT be enqueued. Likewise, if it returns false, the event is
processed as usual (i.e. enqueued and forwarded to the views controller).
The global listener is called before the local listener, which is called
before the keyboard listener. If any returns true, later listeners wont get
the event.
EventListeners were added to allow the implementation of event recorders
or other spy functionality. They also allow hooking up views which otherwise
insist on doing things themself.
Notice, that beside event listening, you can also define a delegate for
a views keyboard and button events.
Read the documentation in WindowEvent for more info.
[instance variables:]
eventSemaphore <Semaphore> the semaphore to be signalled when an event
(or damage) arrives
damage <Collection> collection of damage events
mouseAndKeyboard <Collection> collection of user events
compressMotionEvents <Boolean> if true, multiple motion events are
compressed to one event. If false, each
event is handled individual.
(should be set to false when doing free-hand drawing)
ignoreUserInput <Boolean> if true, key & button events are ignored
(usually set to true by WindowGroup, while a
modalbox covers a view)
shiftDown <Boolean> true while shift/meta/control-key is pressed
metaDown (to support ST-80 style query: sensor shiftDown)
ctrlDown
altDown (notice, that on most systems, alt and meta key is
the same, both reported as #Alt)
exposeEventSemaphore <Semaphore> X-special: semaphore to be signalled when
expose event arrives after a copyArea.
catchExpose <Boolean> true, while waiting for an expose event
(after a copyArea)
gotExpose <Boolean> set to true, when an expose event arrives
(after a copyarea)
gotOtherEvent <Boolean> set to true if other events arrive while
waiting for expose (after a copyarea).
translateKeyboardEvents <Boolean> if true, keyboard events are translated via
the devices leyboardMap; if false, they
are reported as raw-keys. Default is true.
eventListener <Object> if non nil, this one will get all pointer
and keyboard events for this sensors views first.
If it returns true, the event is supposed to
be already handled by the listener and not sent to
the view. If false, the event is handled as usual.
This allows applications to catch events for any of
its views.
keyboardListener <Object> if non nil, this one will get all keyboard events
for this sensors views first (but after the eventListener,
if any).
If it returns true, the event is supposed to
be already handled by the listener and not sent to
the view. If false, the event is handled as usual.
This allows applications to catch events for any of
its views.
ApplicationModels can catch keyboard input with:
postOpenWith:aBuilder
aBuilder window sensor keyboardListener:self
[class variables:]
ControlCEnabled <Boolean> if true (which is the default) Control-C
will interrupt the process handling the
view.
For secure stand-alone applications,
this can be set to false, in which case
Control-C does NOT interrupt the process.
EventListener <Object> if non nil, this one will get all pointer
and keyboard events for ALL views first.
If it returns true, the event is supposed to
be already handled by the listener and not enqueued.
If false, the event is handled as usual.
This allows overall event catchers to be
installed for example to implement event
recorders, active help managers etc.
ComposeTable <Array> compose-key translation table
[see also:]
WindowGroup
WindowEvent KeyboardMap KeyboardForwarder EventListener
DeviceWorkstation View
"
! !
!WindowSensor class methodsFor:'initialization'!
initialize
"initialize the classes constants"
ControlCEnabled := true.
ComposeTable isNil ifTrue:[
self initializeComposeKeyTable
]
"
WindowSensor initialize
"
"Modified: 22.4.1996 / 16:19:24 / cg"
!
initializeComposeKeyTable
"setup the composeKey table"
ComposeTable := #(
"/ key1 key2 -> character or asciiValue
($+ $+ $#) "/ number-sign
($A $A $@) "/ at-sign
($( $- ${) "/ left brace
($) $- $}) "/ right brace
($| $c 16rA2) "/ cent-sign
($| $S $$) "/ dollar-sign
($= $L 16rA3) "/ pound-sign
($= $Y 16rA5) "/ yen-sign
($!! $s 16rA7) "/ section-sign
($O $C 16rA9) "/ copyright
($< $< 16rAB) "/ french <<-quotes
($O $R 16rAE) "/ registered
($/ $u 16rB5) "/ greek mu
($!! $p 16rB6) "/ paragraph sign
($> $> 16rBB) "/ french >> quotes
($^ $0 16rB0) "/ degree sign
($+ $- 16rB1) "/ plus-minus
($^ $2 16rB2) "/ superscript-2
($^ $3 16rB3) "/ superscript-3
"/ ($. $^ 16rB7) "/ middle dot
($^ $. 16rB7) "/ middle dot
($^ $1 16rB9) "/ superscript-1
($1 $4 16rBC) "/ 1/4
($1 $2 16rBD) "/ 1/2
($3 $4 16rBE) "/ 3/4
($? $? 16rBF) "/ ?-inverted
($- $: 16rF7) "/ divide
"/ diacriticals: Compose diacrit character
"/ grave
($A $` 16rC0) "/ A-`
($a $` 16rE0) "/ a-`
($E $` 16rC8) "/ E-`
($e $` 16rE8) "/ e-`
($I $` 16rCC) "/ I-`
($i $` 16rEC) "/ i-`
($O $` 16rD2) "/ O-`
($o $` 16rF2) "/ o-`
($U $` 16rD9) "/ U-`
($u $` 16rF9) "/ u-`
"/ acute
($A $' 16rC1) "/ A-'
($a $' 16rE1) "/ a-'
($E $' 16rC9) "/ E-'
($e $' 16rE9) "/ e-'
($I $' 16rCD) "/ I-'
($i $' 16rED) "/ i-'
($O $' 16rD3) "/ O-'
($o $' 16rF3) "/ o-'
($U $' 16rDA) "/ U-'
($u $' 16rFA) "/ u-'
($Y $' 16rDD) "/ Y-'
($y $' 16rFD) "/ y-'
"/ circumflex
($A $^ 16rC2) "/ A-^
($a $^ 16rE2) "/ a-^
($E $^ 16rCA) "/ E-^
($e $^ 16rEA) "/ e-^
($I $^ 16rCE) "/ I-^
($i $^ 16rEE) "/ i-^
($O $^ 16rD4) "/ O-^
($o $^ 16rF4) "/ o-^
($U $^ 16rDB) "/ U-^
($u $^ 16rFB) "/ u-^
"/ tilde
($A $~ 16rC3) "/ A-~
($a $~ 16rE3) "/ a-~
($O $~ 16rD5) "/ O-~
($o $~ 16rF5) "/ o-~
($N $~ 16rD1) "/ N-tilde
($n $~ 16rF1) "/ n-~
"/ ring above
($a $* 16rE5) "/ a-*
($A $* 16rC5) "/ A-*
"/ cedille
($C $, 16rC7) "/ C-,
($c $, 16rE7) "/ c-,
"/ dieresis
($A $" 16rC4) "/ A-"
($a $" 16rE4) "/ a-"
($E $" 16rCB) "/ E-"
($e $" 16rEB) "/ e-"
($I $" 16rCF) "/ I-"
($i $" 16rEF) "/ i-"
($O $" 16rD6) "/ O-"
($o $" 16rF6) "/ o-"
($U $" 16rDC) "/ U-"
($u $" 16rFC) "/ u-"
($y $" 16rFF) "/ y-"
"/ ligatures
($s $s 16rDF) "/ german sz
($a $e 16rE6) "/ (french) ae
($A $E 16rC6) "/ (french) AE
).
"
WindowSensor initializeComposeKeyTable
"
"Created: 22.4.1996 / 14:06:43 / cg"
"Modified: 22.4.1996 / 16:19:04 / cg"
! !
!WindowSensor class methodsFor:'instance creation'!
new
"return a new initialized instance"
^ self basicNew initialize
"Modified: 22.4.1996 / 16:19:40 / cg"
! !
!WindowSensor class methodsFor:'accessing'!
composeTable
"return the compose-key table.
Entries consist of 3-element arrays each, where
the first two entries (of each entry) are the raw characters,
and the third is the resulting composed-key"
^ ComposeTable
!
composeTable:aTable
"set the compose-key table.
Entries consist of 3-element arrays each, where
the first two entries (of each entry) are the raw characters,
and the third is the resulting composed-key"
ComposeTable := aTable
!
controlCEnabled:aBoolean
"enable/disable Control-C processing.
If enabled, pressing CNTL-C in a view will interrupt it and bring
its process into the debugger (actually raising signal).
Otherwise, CNTL-C is sent to the view like any other key.
The default is true (enabled).
"
ControlCEnabled := aBoolean
!
eventListener
"return the eventListener
- see documentation for what this can be used for"
^ EventListener
!
eventListener:aListener
"set the eventListener
- see documentation for what this can be used for"
EventListener := aListener
! !
!WindowSensor class methodsFor:'queries'!
cursorPoint
"ST-80 compatibility:
return the position of the cursor on the current display"
^ Screen current pointerPosition
"
WindowSensor cursorPoint
"
! !
!WindowSensor methodsFor:'accessing'!
compressMotionEvents:aBoolean
"turn on/off motion event compression"
compressMotionEvents := aBoolean
!
eventListener
"return the eventListener
- see documentation for what this can be used for"
^ eventListener
!
eventListener:aListener
"set the eventListener
- see documentation for what this can be used for"
eventListener := aListener
!
eventSemaphore
"return the semaphore used to signal event arrival"
^ eventSemaphore
!
eventSemaphore:aSemaphore
"set the semaphore used to signal event arrival"
eventSemaphore := aSemaphore
!
ignoreUserInput
"return true, if Ctrl-C processing is currently turned off"
^ ignoreUserInput
!
ignoreUserInput:aBoolean
"turn on/off ignoring of Ctrl-C processing"
ignoreUserInput := aBoolean
!
keyboardListener
"return the keyboardListener
- see documentation for what this can be used for"
^ keyboardListener
!
keyboardListener:aListener
"set the keyboardListener
- see documentation for what this can be used for"
keyboardListener := aListener
! !
!WindowSensor methodsFor:'event flushing'!
compressKeyPressEventsWithKey:aKey
"count and remove multiple pending keyPress events for the
same key, aKey. This is currently used in TextViews to compress
multiple cursorUp/cursorDown events and do the scroll in one
operation. (to avoid run-after-cursor on slow displays)"
|n ev|
n := 0.
ev := self pendingEvent.
[ev notNil and:[ev isKeyPressEvent]] whileTrue:[
((ev arguments at:1) == aKey) ifTrue:[
n := n + 1.
self nextEvent.
ev := self pendingEvent.
] ifFalse:[
ev := nil
]
].
^ n
!
flushEventsFor:aView
"throw away all events for aView,
or any view, if the argument is nil."
self flushExposeEventsFor:aView.
self flushUserEventsFor:aView.
!
flushExposeEvents
"throw away all pending expose events; this
can be done after a full redraw (or in views, which are
doing full redraws anly)"
(damage isNil or:[damage size > 0]) ifTrue:[
damage := OrderedCollection new
].
!
flushExposeEventsFor:aView
"throw away all pending expose events for aView,
or any view, if the argument is nil.
This can be done after a full redraw
(or in views, which are always doing full redraws -
instead of drawing the clip-area only)"
|nEvent "{ Class: SmallInteger }"|
damage notNil ifTrue:[
nEvent := damage size.
1 to:nEvent do:[:index |
|aDamage|
aDamage := damage at:index.
aDamage notNil ifTrue:[
(aView isNil or:[aDamage view == aView]) ifTrue:[
damage at:index put:nil
]
]
]
].
!
flushKeyboard
"ST-80 compatibility: throw away all pending keyboard events"
self flushKeyboardFor:nil
!
flushKeyboardFor:aView
"throw away all pending keyboard events for aView,
or any view, if the argument is nil."
|nEvent "{ Class: SmallInteger }"|
mouseAndKeyboard notNil ifTrue:[
nEvent := mouseAndKeyboard size.
1 to:nEvent do:[:i |
|anEvent|
anEvent := mouseAndKeyboard at:i.
(anEvent notNil and:[anEvent isKeyEvent]) ifTrue:[
(aView isNil or:[anEvent view == aView]) ifTrue:[
mouseAndKeyboard at:i put:nil
]
]
]
].
!
flushUserEvents
"throw away all pending user events"
(mouseAndKeyboard isNil or:[mouseAndKeyboard size > 0]) ifTrue:[
mouseAndKeyboard := OrderedCollection new
].
!
flushUserEventsFor:aView
"throw away all pending user events for aView,
or any view, if the argument is nil."
|nEvent "{ Class: SmallInteger }"|
mouseAndKeyboard notNil ifTrue:[
nEvent := mouseAndKeyboard size.
1 to:nEvent do:[:i |
|anEvent|
anEvent := mouseAndKeyboard at:i.
anEvent notNil ifTrue:[
(aView isNil or:[anEvent view == aView]) ifTrue:[
mouseAndKeyboard at:i put:nil
]
]
]
].
! !
!WindowSensor methodsFor:'event processing'!
buttonMotion:state x:x y:y view:aView
"mouse was moved - this is sent from the device (Display)"
|args|
EventListener notNil ifTrue:[
(EventListener buttonMotion:state x:x y:y view:aView) ifTrue:[^ self]
].
eventListener notNil ifTrue:[
(eventListener buttonMotion:state x:x y:y view:aView) ifTrue:[^ self]
].
ignoreUserInput == true ifTrue:[
^ self
].
args := Array with:state with:x with:y.
compressMotionEvents ifTrue:[
"
merge with last motion
"
mouseAndKeyboard reverseDo:[:ev |
ev notNil ifTrue:[
((ev type == #buttonMotion:x:y:)
and:[(ev view == aView)
and:[(ev arguments at:1) == state]]) ifTrue:[
ev arguments:args.
^ self
]
]
]
].
mouseAndKeyboard
addLast:(WindowEvent
for:aView
type:#buttonMotion:x:y:
arguments:args).
self notifyEventArrival
!
buttonMultiPress:button x:x y:y view:aView
"mouse button was pressed - this is sent from the device (Display)"
EventListener notNil ifTrue:[
(EventListener buttonMultiPress:button x:x y:y view:aView) ifTrue:[^ self]
].
eventListener notNil ifTrue:[
(eventListener buttonMultiPress:button x:x y:y view:aView) ifTrue:[^ self]
].
ignoreUserInput == true ifTrue:[
^ self
].
mouseAndKeyboard
addLast:(WindowEvent
for:aView
type:#buttonMultiPress:x:y:
arguments:(Array with:button with:x with:y)).
self notifyEventArrival
!
buttonPress:button x:x y:y view:aView
"mouse button was pressed - this is sent from the device (Display)"
self button:button inView:aView state:true.
EventListener notNil ifTrue:[
(EventListener buttonPress:button x:x y:y view:aView) ifTrue:[^ self]
].
eventListener notNil ifTrue:[
(eventListener buttonPress:button x:x y:y view:aView) ifTrue:[^ self]
].
ignoreUserInput == true ifTrue:[
^ self
].
mouseAndKeyboard
addLast:(WindowEvent
for:aView
type:#buttonPress:x:y:
arguments:(Array with:button with:x with:y)).
self notifyEventArrival
!
buttonRelease:button x:x y:y view:aView
"mouse button was released- this is sent from the device (Display)"
self button:button inView:aView state:false.
EventListener notNil ifTrue:[
(EventListener buttonRelease:button x:x y:y view:aView) ifTrue:[^ self]
].
eventListener notNil ifTrue:[
(eventListener buttonRelease:button x:x y:y view:aView) ifTrue:[^ self]
].
ignoreUserInput == true ifTrue:[
^ self
].
mouseAndKeyboard
addLast:(WindowEvent
for:aView
type:#buttonRelease:x:y:
arguments:(Array with:button with:x with:y)).
self notifyEventArrival
!
buttonShiftPress:button x:x y:y view:aView
"mouse button was pressed - this is sent from the device (Display)"
self button:button inView:aView state:true.
EventListener notNil ifTrue:[
(EventListener buttonShiftPress:button x:x y:y view:aView) ifTrue:[^ self]
].
eventListener notNil ifTrue:[
(eventListener buttonShiftPress:button x:x y:y view:aView) ifTrue:[^ self]
].
ignoreUserInput == true ifTrue:[
^ self
].
mouseAndKeyboard
addLast:(WindowEvent
for:aView
type:#buttonShiftPress:x:y:
arguments:(Array with:button with:x with:y)).
self notifyEventArrival
!
configureX:x y:y width:w height:h view:aView
"a views size or position has changed - this is sent from the device (Display)"
damage
addLast:(WindowEvent
for:aView
type:#configureX:y:width:height:
arguments:(Array with:x with:y with:w with:h)).
self notifyEventArrival
!
coveredBy:sibling view:aView
"aView was covered by one of its siblings - this is sent from the device (Display)"
damage
addLast:(WindowEvent
for:aView
type:#coveredBy:
arguments:(Array with:sibling)).
self notifyEventArrival
!
destroyedView:aView
"view was destroyed (from window manager) - this is sent from the device (Display)"
"at this time, the view is already gone; remove
all pending events for this one ..."
self flushEventsFor:aView.
damage
addLast:(WindowEvent
for:aView
type:#destroyed).
self notifyEventArrival
!
exposeX:left y:top width:width height:height view:aView
"an expose event arrived - this is sent from the device (Display)"
(self addDamage:(Rectangle left:left top:top width:width height:height) view:aView) ifTrue:[
self notifyEventArrival
]
!
focusInView:aView
"view got input focus - this is sent from the device (Display)"
mouseAndKeyboard
addLast:(WindowEvent
for:aView
type:#focusIn).
self notifyEventArrival
!
focusOutView:aView
"view lost input focus - this is sent from the device (Display)"
mouseAndKeyboard
addLast:(WindowEvent
for:aView
type:#focusOut).
self notifyEventArrival
!
graphicExposeX:left y:top width:width height:height view:aView
"a graphic expose event arrived - this is sent from the device (Display)"
self addDamage:(left @ top extent:width @ height) view:aView.
!
keyPress:key x:x y:y view:aView
"key was pressed - this is sent from the device (Display).
beside the keyboard translation, CntlC processing is done here."
<resource: #keyboard ( #Compose #DestroyView #DestroyTopView #FlushInput
#UserInterrupt ) >
|xlatedKey group process|
self key:key state:true.
EventListener notNil ifTrue:[
(EventListener keyPress:key x:x y:y view:aView) ifTrue:[^ self]
].
eventListener notNil ifTrue:[
(eventListener keyPress:key x:x y:y view:aView) ifTrue:[^ self]
].
keyboardListener notNil ifTrue:[
(keyboardListener keyPress:key x:x y:y view:aView) ifTrue:[^ self]
].
translateKeyboardEvents ifTrue:[
xlatedKey := aView device translateKey:key.
] ifFalse:[
xlatedKey := key.
].
xlatedKey isNil ifTrue:[^ self].
(xlatedKey == #Compose) ifTrue:[
GotCompose := true. Compose1 := nil.
^ self
].
GotCompose == true ifTrue:[
Compose1 isNil ifTrue:[
(self isModifierKey:xlatedKey) ifFalse:[
Compose1 := xlatedKey.
].
^ self
].
(self isModifierKey:xlatedKey) ifFalse:[
xlatedKey := self compose:Compose1 with:xlatedKey.
Compose1 := nil. GotCompose := false.
]
].
(xlatedKey == #CmdCtrlV) ifTrue:[
'Smalltalk/X ' errorPrint.
Smalltalk versionString errorPrint. ' of ' errorPrint.
Smalltalk versionDate errorPrintNL.
Smalltalk copyrightString errorPrintNL.
].
(xlatedKey == #DestroyView) ifTrue:[
aView closeRequest.
].
(xlatedKey == #DestroyTopView) ifTrue:[
aView topView closeRequest.
].
(xlatedKey == #FlushInput) ifTrue:[
"this removes any enqueued user events -
helps, if you pressed DoIt too often, and want to flush those
"
self flushUserEvents.
^ self
].
((xlatedKey == #UserInterrupt) and:[ControlCEnabled]) ifTrue:[
"
Special handling for Ctrl-C: interrupt the underlying process.
cannot halt here (this would stop the event-dispatcher),
but instead interrupt the underlying process and have it
perform the userInterrupt in the interrupt-method.
"
group := aView windowGroup.
group notNil ifTrue:[
process := group process.
process notNil ifTrue:[
process interruptWith:[process userInterrupt]
]
].
^ self
].
ignoreUserInput == true ifTrue:[
^ self
].
mouseAndKeyboard
addLast:(WindowEvent
for:aView
type:#keyPress:x:y:
arguments:(Array with:xlatedKey with:x with:y)).
self notifyEventArrival
"Modified: 7.3.1996 / 13:20:25 / cg"
!
keyRelease:key x:x y:y view:aView
"key was released - this is sent from the device (Display)."
|xlatedKey|
self key:key state:false.
EventListener notNil ifTrue:[
(EventListener keyRelease:key x:x y:y view:aView) ifTrue:[^ self]
].
eventListener notNil ifTrue:[
(eventListener keyRelease:key x:x y:y view:aView) ifTrue:[^ self]
].
keyboardListener notNil ifTrue:[
(keyboardListener keyRelease:key x:x y:y view:aView) ifTrue:[^ self]
].
ignoreUserInput == true ifTrue:[
^ self
].
translateKeyboardEvents ifTrue:[
xlatedKey := aView device translateKey:key.
] ifFalse:[
xlatedKey := key.
].
xlatedKey isNil ifTrue:[^ self].
mouseAndKeyboard
addLast:(WindowEvent
for:aView
type:#keyRelease:x:y:
arguments:(Array with:xlatedKey with:x with:y)).
self notifyEventArrival
!
mappedView:aView
"view was mapped (from window manager) - this is sent from the device (Display)"
damage
addLast:(WindowEvent
for:aView
type:#mapped).
self notifyEventArrival
!
noExposeView:aView
"an noexpose event arrived - this is sent from the device (Display)"
gotExpose := true.
exposeEventSemaphore notNil ifTrue:[
exposeEventSemaphore signal
]
!
pointerEnter:state x:x y:y view:aView
"mouse cursor was moved into the view - this is sent from the device (Display)"
"/ update my idea of shift/alt/ctrl pressed information
self updateModifierStateFrom:state device:(aView device).
EventListener notNil ifTrue:[
(EventListener pointerEnter:state x:x y:y view:aView) ifTrue:[^ self]
].
eventListener notNil ifTrue:[
(eventListener pointerEnter:state x:x y:y view:aView) ifTrue:[^ self]
].
mouseAndKeyboard
addLast:(WindowEvent
for:aView
type:#pointerEnter:x:y:
arguments:(Array with:state with:x with:y)).
self notifyEventArrival
"Modified: 27.2.1996 / 14:54:47 / cg"
!
pointerLeave:state view:aView
"mouse cursor was moved out of the view - this is sent from the device (Display)"
EventListener notNil ifTrue:[
(EventListener pointerLeave:state view:aView) ifTrue:[^ self]
].
eventListener notNil ifTrue:[
(eventListener pointerLeave:state view:aView) ifTrue:[^ self]
].
mouseAndKeyboard
addLast:(WindowEvent
for:aView
type:#pointerLeave:
arguments:(Array with:state)).
self notifyEventArrival
!
saveAndTerminateView:aView
"view should save & terminate (from window manager) - this is sent from the device (Display)"
self flushEventsFor:aView.
damage
addLast:(WindowEvent
for:aView
type:#saveAndTerminate).
self notifyEventArrival
!
terminateView:aView
"view should terminate (from window manager) - this is sent from the device (Display)"
self flushEventsFor:aView.
damage
addLast:(WindowEvent
for:aView
type:#terminate).
self notifyEventArrival
!
unmappedView:aView
"view was unmapped (from window manager) - this is sent from the device (Display)"
damage
addLast:(WindowEvent
for:aView
type:#unmapped).
self notifyEventArrival
! !
!WindowSensor methodsFor:'event processing - private'!
button:button inView:aView state:onOrOff
"update the state of the xxxButtonDown flags"
|physicalButton|
physicalButton := aView device buttonTranslation keyAtValue:button ifAbsent:button.
(physicalButton == 1) ifTrue:[
leftButtonDown := onOrOff.
^ self
].
(physicalButton == 2) ifTrue:[
middleButtonDown := onOrOff.
^ self
].
(physicalButton == 3) ifTrue:[
rightButtonDown := onOrOff.
^ self
].
!
compose:key1 with:key2
"compose a 2-character sequence into a composed key"
ComposeTable do:[:entry |
|v|
((key1 == (entry at:1)) and:[key2 == (entry at:2)]) ifTrue:[
v := entry at:3.
v isCharacter ifFalse:[v := Character value:v].
^ v
]
].
"/
"/ for illegal sequence, return 2nd key
"/
"/ key1 print. ' ' print. key2 printNL.
^ key2
!
isModifierKey:key
"return true if key is a modifier (Alt, Shift, Ctrl or Meta)"
(key == #Shift
or:[key == #'Shift_R'
or:[key == #'Shift_L']]) ifTrue:[
^ true
].
(key == #Alt
or:[key == #'Alt_R' or:[key == #'Alt_L']]) ifTrue:[
^ true
].
(key == #Meta
or:[key == #'Meta_R' or:[key == #'Meta_L']]) ifTrue:[
^ true
].
(key == #Control
or:[key == #'Control_R' or:[key == #'Control_L']]) ifTrue:[
^ true
].
^ false
"Modified: 22.4.1996 / 16:22:16 / cg"
!
key:key state:onOrOff
"update the state of the shiftDown/metaDown and ctrlDown
flags"
(key = #Shift
or:[key = #'Shift_R'
or:[key = #'Shift_L']]) ifTrue:[
shiftDown := onOrOff.
^ self
].
(key = #Alt
or:[key = #'Alt_R' or:[key = #'Alt_L']]) ifTrue:[
altDown := onOrOff.
^ self
].
(key = #Meta
or:[key = #'Meta_R' or:[key = #'Meta_L']]) ifTrue:[
metaDown := onOrOff.
^ self
].
(key = #Control
or:[key = #'Control_R' or:[key = #'Control_L']]) ifTrue:[
ctrlDown := onOrOff.
^ self
].
!
notifyEventArrival
"an event arrived - if there is an eventSemaphore,
signal it, to wake up any windowGroup process"
catchExpose == true ifTrue:[
"
dont wake up, if we are currently waiting for an expose
but remember arrival of something.
"
gotOtherEvent := true.
^ self
].
eventSemaphore notNil ifTrue:[
eventSemaphore signal
]
!
updateModifierStateFrom:state device:aDevice
"this refetches the modifier key-states.
Called privately when pointer enters a view."
"/ Prevents wrong behavior in the following scenario:
"/ ctrl is pressed in a view
"/ pointer is moved out of view
"/ ctrl is released
"/ pointer moved back into view
"/ popup-menu still thinks that ctrl is pressed"
"/ could do it from state - but I am lazy
shiftDown := aDevice shiftDown.
ctrlDown := aDevice ctrlDown.
metaDown := aDevice metaDown.
altDown := aDevice altDown.
"Created: 27.2.1996 / 14:54:38 / cg"
"Modified: 22.4.1996 / 16:22:40 / cg"
! !
!WindowSensor methodsFor:'event queue'!
addDamage:aRectangle view:aView
"Add aRectangle to the damage list.
Try to merge incoming rectangles with the existing damage rectangles.
Incoming rectangles which are completely contained in any existing damage rect are ignored,
any existing damage rectangle which is completely contained in the incoming rectangle
is replaced. Also, rectangles are merged into bigger ones, if they join exactly.
Except for special cases (moveOpaque of a view over one of my views),
these optimizations are not noticable."
|temp index newEvent r rL rT rB rR
count "{ Class: SmallInteger }"
sz "{ Class: SmallInteger }"
firstInteresting "{ Class: SmallInteger }"
lastInteresting "{ Class: SmallInteger }"|
r := aRectangle.
aView redrawsFull ifTrue:[
r := 0@0 corner:9999@9999
].
sz := damage size.
sz == 0 ifTrue: [
damage := OrderedCollection new:10.
] ifFalse:[
"
first look, if this rectangle is already in the expose list;
if so, dont add to queue
On the fly, count the number of damages for this view
"
count := firstInteresting := 0.
1 to:sz do:[:i |
|aDamage|
aDamage := damage at:i.
aDamage notNil ifTrue:[
aDamage isDamage ifTrue:[
aDamage view == aView ifTrue:[
((aDamage rectangle) contains:r) ifTrue: [^ false].
count := count + 1.
lastInteresting := i.
firstInteresting == 0 ifTrue:[
firstInteresting := i
]
]
]
].
].
"
are there any damages for this view in the queue ?
"
firstInteresting ~~ 0 ifTrue:[
"
if there are already many damages for this view,
remove them all, and replace by a full expose
This limits the runtime spent here, which may become big
due to the square runtime behavior (stupid algorithm ...)
"
count > 20 ifTrue:[
r := 0@0 corner:99999@99999.
].
"
then look, if the new rectangle contains any in the expose list;
if so, remove the old damage (here, by nilling it in the queue).
Or, merge it with existing rectangles if possible.
"
count := 0.
rR := r right.
rL := r left.
rT := r top.
rB := r bottom.
firstInteresting to:lastInteresting do:[:i |
|aDamage dRect dL dR dT dB|
aDamage := damage at:i.
aDamage notNil ifTrue:[
aDamage isDamage ifTrue:[
(aDamage view) == aView ifTrue:[
dRect := aDamage rectangle.
(r contains:dRect) ifTrue: [
damage at:i put:nil.
count := count + 1
] ifFalse:[
dL := dRect left.
dT := dRect top.
dR := dRect right.
dB := dRect bottom.
(rT == dT
and:[rB == dB]) ifTrue:[
(rR > dR) ifTrue: [
(rL <= (dR + 1)) ifTrue: [
dRect right:rR.
^ false
]
].
(rL < dL) ifTrue: [
(rR >= (dL - 1)) ifTrue: [
dRect left:rL.
^ false
]
]
].
(rR == dR
and:[rL == dL]) ifTrue:[
(rB > dB) ifTrue: [
(rT <= (dB + 1)) ifTrue: [
dRect bottom:rB.
^ false
]
].
(rT < dT) ifTrue: [
(rB >= (dT - 1)) ifTrue: [
dRect top:rT.
^ false
]
]
]
]
]
]
]
].
"
if we nilled more then 10 events, reorganize the queue
(doing this for every 10 removes only avoids excessive
reorganization of the input queue)
"
count > 10 ifTrue: [
temp := OrderedCollection new:(sz - count + 1).
index := 1.
damage do:[:aDamage |
aDamage notNil ifTrue: [
temp add:aDamage.
]
].
damage := temp
].
].
].
newEvent := WindowEvent damageFor:aView rectangle:r.
damage add:newEvent.
^ true
"Modified: 4.3.1996 / 16:44:23 / cg"
!
damage
"retrieve the next damage rectangle or nil, if there is none.
Remove it from the queue."
^ damage.
!
nextDamage
"retrieve the next damage rectangle or nil, if there is none.
Remove it from the queue."
|d wasBlocked|
[d isNil] whileTrue:[
damage size == 0 ifTrue:[^ nil].
"
be careful: events are inserted at higher prio ...
"
[
d := damage removeFirst.
] valueUninterruptably
].
^ d
"Modified: 28.2.1996 / 21:28:59 / cg"
!
nextEvent
"retrieve the next event or nil, if there is none.
Remove it from the queue."
|e wasBlocked|
[e isNil] whileTrue:[
mouseAndKeyboard size == 0 ifTrue:[^ nil].
"
be careful: events are inserted at higher prio ...
"
[
e := mouseAndKeyboard removeFirst.
] valueUninterruptably
].
^ e
"Modified: 28.2.1996 / 21:28:37 / cg"
!
pendingEvent
"retrieve the next pending user (i.e. non-damage) event.
Return nil, if there is none pending.
Do not remove it from the queue."
|e wasBlocked|
[e isNil] whileTrue:[
mouseAndKeyboard size == 0 ifTrue:[^ nil].
"
be careful: events are inserted at higher prio ...
"
[
e := mouseAndKeyboard first.
e isNil ifTrue:[
mouseAndKeyboard removeFirst
].
] valueUninterruptably
].
^ e
"Modified: 28.2.1996 / 21:28:45 / cg"
! !
!WindowSensor methodsFor:'event simulation'!
forwardKeyEventsTo:aView
"remove all keyboard events and send them to aViews sensor instead"
"/ 'fwd' printNL.
1 to:mouseAndKeyboard size do:[:i |
|anEvent|
anEvent := mouseAndKeyboard at:i.
anEvent notNil ifTrue:[
anEvent isKeyEvent ifTrue:[
anEvent view:aView.
aView sensor pushEvent:anEvent.
"/ anEvent type printNL.
mouseAndKeyboard at:i put:nil
]
]
].
!
pushEvent:anEvent
"manually put an event into the queue - this allows
simulation of events (implementation of recorders & playback)
or asynchronous communication between view applications."
mouseAndKeyboard addLast:anEvent.
self notifyEventArrival
"Created: 18.9.1995 / 22:37:57 / claus"
!
pushUserEvent:aSelector for:aView
"manually put an event into the queue - this allows
simulation of events (implementation of recorders & playback)
or asynchronous communication between view applications.
The view will perform a method as specified by aSelector,
when it performs event processing; this is different than sending
this message directly, since the execution is done by the views process,
not by the current process (which is especially worthwhile, if that method
shows a modal box or similar)."
self pushUserEvent:aSelector for:aView withArguments:#()
"Modified: 18.9.1995 / 22:40:12 / claus"
!
pushUserEvent:aSelector for:aView withArguments:arguments
"manually put an event into the queue - this allows
simulation of events (implementation of recorders & playback)
or asynchronous communication between view applications.
The view will perform a method as specified by aSelector,
when it performs event processing; this is different than sending
this message directly, since the execution is done by the views process,
not by the current process (which is especially worthwhile, if that method
shows a modal box or similar)."
self pushEvent:(WindowEvent
for:aView
type:aSelector
arguments:arguments).
"
|b|
b := Button label:'test'.
b open.
(Delay forSeconds:5) wait.
b sensor pushEvent:#pointerEnter:x:y: for:b withArguments:#(0 1 1).
(Delay forSeconds:1) wait.
b sensor pushEvent:#buttonPress:x:y: for:b withArguments:#(1 1 1).
(Delay forSeconds:2) wait.
b sensor pushEvent:#buttonRelease:x:y: for:b withArguments:#(1 1 1).
(Delay forSeconds:1) wait.
b sensor pushEvent:#pointerLeave: for:b withArguments:#(0).
"
! !
!WindowSensor methodsFor:'initialization'!
initialize
"initialize the event queues to empty"
damage := OrderedCollection new.
mouseAndKeyboard := OrderedCollection new.
gotExpose := true.
catchExpose := false.
compressMotionEvents := translateKeyboardEvents := true.
ignoreUserInput := false.
shiftDown := ctrlDown := altDown := metaDown := false.
leftButtonDown := middleButtonDown := rightButtonDown := false.
!
reinitialize
"called when an image is restarted;
reinitialize the event queues to empty; leave other setup as-is"
self flushUserEvents.
self flushExposeEvents.
gotExpose := true.
catchExpose := false.
shiftDown := ctrlDown := altDown := metaDown := false.
leftButtonDown := middleButtonDown := rightButtonDown := false.
! !
!WindowSensor methodsFor:'queries '!
altDown
"return true, if the meta key is currently pressed.
Notice, that some keyboards dont have an alt key;
it is better to use 'sensor metaDown or:[sensor altDown]'."
^ altDown
!
anyButtonPressed
"ST-80 compatibility: return true, if any mouse button is pressed.
You should no use it in 'normal' applications.
Instead, keep track of the buttons state in your views or controllers
button-event methods."
^ rightButtonDown or:[middleButtonDown or:[rightButtonDown]]
!
blueButtonPressed
"ST-80 compatibility: return true, if the right mouse button is pressed.
You should no use it in 'normal' applications.
Instead, keep track of the buttons state in your views or controllers
button-event methods."
^ rightButtonDown
!
ctrlDown
"return true, if any CTRL key is currently pressed."
^ ctrlDown
!
cursorPoint
"ST-80 compatibility:
return the position of the mouse pointer on the current display
(in screen coordinates)"
^ self class cursorPoint
!
eventPending
"return true, if either damage or events are pending"
mouseAndKeyboard size ~~ 0 ifTrue:[^ true].
^ damage size ~~ 0
!
globalOrigin
"ST-80 compatibility:
dont know what we should return here ...
... at least the PD program which uses it works when we return 0@0."
^ 0@0
!
hasButtonMotionEventsFor:aView
"return true, if any buttonMotion events are pending.
If the argument, aView is nil, the information is regarding any
view (i.e. is there a motion event for any of my views);
otherwise, the information is regrding that specific view."
^ self hasEvent:#buttonMotion:x:y: orPendingDeviceEvent:#buttonMotion for:aView
!
hasButtonPressEventFor:aView
"return true, if any buttonPress events are pending.
If the argument, aView is nil, the information is regarding any
view (i.e. is there a motion event for any of my views);
otherwise, the information is regrding that specific view."
^ self hasEvent:#buttonPress:x:y: orPendingDeviceEvent:#buttonPress for:aView
!
hasButtonReleaseEventFor:aView
"return true, if any buttonRelease events are pending.
If the argument, aView is nil, the information is regarding any
view (i.e. is there a motion event for any of my views);
otherwise, the information is regrding that specific view."
^ self hasEvent:#buttonRelease:x:y: orPendingDeviceEvent:#buttonRelease for:aView
!
hasConfigureEventFor:aView
"return true, if any resize/position events are pending.
If the argument, aView is nil, the information is regarding any
view (i.e. is there a motion event for any of my views);
otherwise, the information is regrding that specific view."
^ self hasEvent:#configureX:y:width:height: orPendingDeviceEvent:#structureNotify for:aView
!
hasDamage
"return true, if any exposure events are pending"
^ damage size ~~ 0
!
hasDamageFor:aView
"return true, if any exposure events are pending for aView"
damage size ~~ 0 ifTrue:[
damage do:[:aDamage |
aDamage notNil ifTrue:[
aDamage view == aView ifTrue:[^ true].
].
]
].
^ false
!
hasEvent:type orPendingDeviceEvent:dType for:aView
"return true, if a specific event is pending.
Type is the type of event, dType the corresponding device event.
If the argument, aView is nil, the information is regarding any
view (i.e. is there a motion event for any of my views);
otherwise, the information is regrding that specific view."
mouseAndKeyboard size ~~ 0 ifTrue:[
mouseAndKeyboard do:[:anEvent |
anEvent notNil ifTrue:[
(aView isNil or:[anEvent view == aView]) ifTrue:[
anEvent type == type ifTrue:[^ true].
]
].
]
].
damage size ~~ 0 ifTrue:[
damage do:[:anEvent |
anEvent notNil ifTrue:[
(aView isNil or:[anEvent view == aView]) ifTrue:[
anEvent type == type ifTrue:[^ true].
]
].
]
].
aView notNil ifTrue:[
^ aView device eventPending:dType for:aView id
].
^ false
!
hasEvents
"return true, if any mouse/keyboard events are pending"
^ mouseAndKeyboard size ~~ 0
!
hasKeyPressEventsFor:aView
"return true, if any keyPress events are pending.
If the argument, aView is nil, the information is regarding any
view (i.e. is there a motion event for any of my views);
otherwise, the information is regrding that specific view."
^ self hasEvent:#keyPress:x:y: orPendingDeviceEvent:#keyPress for:aView
"Created: 23.3.1996 / 14:16:50 / cg"
!
leftButtonPressed
"return true, if the left mouse button is pressed.
This has been added to support ST-80 style button polling;
however, you should no use it in 'normal' applications.
Instead, keep track of the buttons state in your views or controllers
button-event methods."
^ leftButtonDown
!
metaDown
"return true, if the meta key is currently pressed.
Notice, that most keyboards dont have a meta key;
it is better to use 'sensor metaDown or:[sensor altDown]'."
^ metaDown
!
middleButtonPressed
"return true, if the middle mouse button is pressed.
This has been added to support ST-80 style button polling;
however, you should no use it in 'normal' applications.
Instead, keep track of the buttons state in your views or controllers
button-event methods."
^ middleButtonDown
!
motionEventPending
"return true, if any buttonMotion events are pending."
^ self hasButtonMotionEventsFor:nil
"Created: 24.3.1996 / 20:09:55 / cg"
!
mousePoint
"ST-80 compatibility:
return the position of the mouse pointer on the current display
(in screen coordinates)"
^ self cursorPoint
!
redButtonPressed
"ST-80 compatibility: return true, if the left mouse button is pressed.
You should no use it in 'normal' applications.
Instead, keep track of the buttons state in your views or controllers
button-event methods."
^ leftButtonDown
!
rightButtonPressed
"return true, if the right mouse button is pressed.
This has been added to support ST-80 style button polling;
however, you should no use it in 'normal' applications.
Instead, keep track of the buttons state in your views or controllers
button-event methods."
^ rightButtonDown
!
shiftDown
"return true, if any shift key is currently pressed."
^ shiftDown
!
yellowButtonPressed
"ST-80 compatibility: return true, if the middle mouse button is pressed.
You should no use it in 'normal' applications.
Instead, keep track of the buttons state in your views or controllers
button-event methods."
^ middleButtonDown
! !
!WindowSensor methodsFor:'special'!
catchExpose
"start catching noExpose events (must be done BEFORE a bitblt,
to prepare for the exposeEventSemaphore to be signalled when
the noExpose event arrives)."
gotExpose := false.
gotOtherEvent := false.
catchExpose := true.
exposeEventSemaphore := Semaphore new.
!
waitButton
"ST-80 compatibility: wait until any mouse button is pressed.
Do not use this in your applications; polling the sensor is
bad style."
[self anyButtonPressed] whileFalse:[
Delay waitForSeconds:0.01.
].
"/ (leftButtonPressed
"/ or:[middleButtonPressed
"/ or:[rightButtonPressed]]) ifTrue:[^ self].
"/
"/ [self hasButtonPressEventFor:nil] whileFalse:[
"/ (Delay forSeconds:0.01) wait.
"/ ]
!
waitForExposeFor:aView
"wait until a graphicsExpose or a noExpose arrives (after a bitblt).
This may be too X-specific, and things may change in this area
in future versions. (or the new device may simulate the arrival of
such an event)"
aView flush.
Processor activeProcessIsSystemProcess ifTrue:[
"
cannot really suspend, if its a systemProcess
"
[gotExpose] whileFalse:[
aView device dispatchExposeEventFor:aView id.
Processor yield.
]
] ifFalse:[
[gotExpose] whileFalse:[
"
just in case we have a (network or software) problem ...
explanation: it may happen, that an expose event is totally
lost - for example, if the network breaks down.
To not block forever, we wait with a timeout, to get out of here
if the event does not arrive after 15 seconds.
"
(exposeEventSemaphore waitWithTimeout:5) isNil ifTrue:[
aView device flush.
"
you can put a comment around the following line, if you dont
like the message ...
"
'WSENSOR: late expose event' errorPrintNL.
(exposeEventSemaphore waitWithTimeout:10) isNil ifFalse:[
'WSENSOR: lost expose event again - ignore' errorPrintNL.
].
"
ok, break out
"
catchExpose := false.
gotExpose := true.
^ self
]
].
"
other incoming events have been ignored during the wait.
Now handle those ...
"
gotOtherEvent ifTrue:[
eventSemaphore signal
].
].
catchExpose := false
"Modified: 16.12.1995 / 02:27:15 / cg"
!
waitNoButton
"ST-80 compatibility: wait until no mouse button is pressed.
Do not use this in your applications; polling the sensor is
bad style."
[self anyButtonPressed] whileTrue:[
Delay waitForSeconds:0.01.
].
"/ (leftButtonPressed
"/ or:[middleButtonPressed
"/ or:[rightButtonPressed]]) ifFalse:[^ self].
"/
"/ [self hasButtonReleaseEventFor:nil] whileFalse:[
"/ (Delay forSeconds:0.01) wait.
"/ ]
! !
!WindowSensor class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.52 1996-04-23 19:56:32 cg Exp $'
! !
WindowSensor initialize!