"
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 ignoreExposeEvents
damageEventAccessLock userEventAccessLock'
classVariableNames:'ControlCEnabled ControlYEnabled 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 <SetOfView> if nonEMpty, the drawables which wait for
an expose/noExpose event. (after a copyArea)
gotExpose <SetOfView> the set of drawables which got an expose/noExpose
event. (after a copyarea)
gotOtherEvent <SetOfView> set of drawables which received if other events,
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
accessLock <Semaphore> controls access to the event queues
[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.
(actually, Control-C is wrong here; the actual
key is #UserInterrupt, which may be mapped onto
any key)
ControlYEnabled <Boolean> if true (which is the default) Control-Y
will raise the abortSignal in the process
handling the view.
This can be used to abort a long operation
(such as a long fileRead in the fileBrowser)
without entering the debugger.
(actually, Control-Y is wrong here; the actual
key is #UserAbort, which may be mapped onto
any key)
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
[author:]
Claus Gittinger
[see also:]
WindowGroup
WindowEvent KeyboardMap KeyboardForwarder EventListener
DeviceWorkstation View
"
! !
!WindowSensor class methodsFor:'initialization'!
initialize
"initialize the classes constants"
ControlCEnabled := true.
ControlYEnabled := true.
ComposeTable isNil ifTrue:[
self initializeComposeKeyTable
]
"
WindowSensor initialize
"
"Modified: / 20.5.1998 / 14:01:52 / cg"
!
initializeComposeKeyTable
"setup the composeKey table"
ComposeTable := #(
"/ format is:
"/ ( 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
($^ $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-"
"/ slashed
($o $/ 16rF8) "/ o-/
($O $/ 16rD8) "/ O-/
"/ 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: 24.4.1996 / 16:37:08 / 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 a UserInterrupt signal).
Otherwise, CNTL-C is sent to the view like any other key.
The default is true (enabled).
Be very careful - only disable CNTL-C handling for well-debugged
applications ... however, even if disabled, there still is the CNTL-C
key on the startup (x)-terminal window (which can also be disabled).
"
ControlCEnabled := aBoolean
"Modified: / 29.10.1997 / 15:48:29 / cg"
!
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:'ST-80 compatibility'!
eventQuit:event
"ST-80 compatibility:
push an event for terminating the topViews application"
^ self pushEvent:(WindowEvent
for:nil
type:#quit)
"Modified: 3.3.1997 / 20:15:00 / cg"
! !
!WindowSensor methodsFor:'accessing'!
compressMotionEvents:aBoolean
"turn on/off motion event compression.
Normally, motion event compression is enabled; however,
applications which want to follow every motion
(i.e. paint-like applications) may want to get them all)"
compressMotionEvents := aBoolean
"Modified: / 6.6.1998 / 21:12:57 / cg"
!
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
!
ignoreExposeEvents:aBoolean
"turn on/off expose event ignoring"
ignoreExposeEvents := aBoolean
"Created: / 21.5.1996 / 18:21:18 / cg"
"Modified: / 6.6.1998 / 21:13:14 / cg"
!
ignoreUserInput
"return true, if user events are currently ignored"
^ ignoreUserInput
"Modified: / 6.6.1998 / 21:13:50 / cg"
!
ignoreUserInput:aBoolean
"turn on/off ignoring of user events processing.
This can be used to avoid hacing events queued for a master-view,
while a modal dialog is open for it."
ignoreUserInput := aBoolean
"Modified: / 6.6.1998 / 21:14:25 / cg"
!
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:'accessing - private'!
criticalDamageEventQueueAccess:aBlock
"perform some action which needs synchronized (exclusive)
access to the damage event queue.
(i.e. protected by a critical region)"
|wasBlocked p|
p := Processor activeProcess.
wasBlocked := p blockInterrupts.
[
damageEventAccessLock critical:aBlock
] valueNowOrOnUnwindDo:[
wasBlocked ifFalse:[
p unblockInterrupts.
]
]
"Created: / 6.6.1998 / 21:04:02 / cg"
"Modified: / 14.10.1998 / 17:17:05 / cg"
!
criticalUserEventQueueAccess:aBlock
"perform some action which needs synchronized (exclusive)
access to the user event queue.
(i.e. protected by a critical region)"
|wasBlocked p|
p := Processor activeProcess.
wasBlocked := p blockInterrupts.
[
userEventAccessLock critical:aBlock
] valueNowOrOnUnwindDo:[
wasBlocked ifFalse:[
p unblockInterrupts.
]
]
"Created: / 6.6.1998 / 21:06:43 / cg"
"Modified: / 14.10.1998 / 15:56:08 / cg"
!
damageEventAccessLock
"return the semaphore which controls access to the damage event queue.
This should probably not be exposed to the public,
so be prepared that this method may vanish."
^ damageEventAccessLock
"Created: / 6.6.1998 / 21:06:14 / cg"
"Modified: / 6.6.1998 / 21:16:49 / cg"
!
userEventAccessLock
"return the semaphore which controls access to the mouse and keyboard event queue.
This should probably not be exposed to the public,
so be prepared that this method may vanish."
^ userEventAccessLock
"Created: / 6.6.1998 / 21:05:56 / cg"
"Modified: / 6.6.1998 / 21:16:57 / cg"
! !
!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 evKey|
n := 0.
ev := self pendingEvent.
[ev notNil and:[ev isKeyEvent]] whileTrue:[
evKey := ev arguments at:1.
(evKey == aKey) ifTrue:[
ev isKeyReleaseEvent ifTrue:[
self nextEvent.
ev := self pendingEvent.
] ifFalse:[
n := n + 1.
self nextEvent.
ev := self pendingEvent.
]
] ifFalse:[
ev := nil
]
].
^ n
"Modified: / 27.1.1998 / 14:15:00 / cg"
!
flushEventsFor:aView
"throw away all events for aView,
or any view, if the argument is nil."
self flushExposeEventsFor:aView.
self flushUserEventsFor:aView.
!
flushEventsFor:aView inQueue:anEventQueue where:aCondition
"throw away all pending damage events for aView,
for which aCondition returns true.
Or any view for which aCondition returns true, if the argument is nil.
A helper for the various flush entries."
|action|
action := [
|nEvent "{ Class: SmallInteger }" anEvent|
damage notNil ifTrue:[
nEvent := anEventQueue size.
1 to:nEvent do:[:index |
anEvent := anEventQueue at:index.
anEvent notNil ifTrue:[
(aView isNil or:[anEvent view == aView]) ifTrue:[
(aCondition value:anEvent) ifTrue:[
anEventQueue at:index put:nil
]
]
]
]
].
].
anEventQueue == damage ifTrue:[
self criticalDamageEventQueueAccess:action
] ifFalse:[
self criticalUserEventQueueAccess:action
]
"Modified: / 6.6.1998 / 21:10:22 / cg"
"Created: / 6.6.1998 / 21:17:54 / cg"
!
flushEventsFor:aView withType:type
"throw away all events for aView,
(or any view, if the argument is nil) which have a particular type."
self flushEventsFor:aView inQueue:damage where:[:event | event type==type].
self flushEventsFor:aView inQueue:mouseAndKeyboard where:[:event | event type==type].
"Created: / 20.6.1998 / 16:41:35 / cg"
"Modified: / 21.7.1998 / 18:16:11 / cg"
!
flushExposeEvents
"throw away all pending expose events; this
can be done after a full redraw (or in views, which are
doing full redraws anly)"
self
flushEventsFor:nil inQueue:damage where:[:event | event isDamage].
"Modified: / 6.6.1998 / 21:18:03 / cg"
!
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)"
self
flushEventsFor:aView inQueue:damage where:[:event | event isDamage].
"Modified: / 6.6.1998 / 21:18:05 / cg"
!
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."
self
flushEventsFor:aView inQueue:mouseAndKeyboard
where:[:event | event isKeyEvent]
"Modified: / 6.6.1998 / 21:18:08 / cg"
!
flushMotionEventsFor:aView
"throw away all pending motion events for aView,
or for any view, if the argument is nil."
self
flushEventsFor:aView inQueue:mouseAndKeyboard
where:[:event | event isButtonMotionEvent]
"Modified: / 6.6.1998 / 21:18:10 / cg"
!
flushUserEvents
"throw away all pending user events (i.e. key & button stuff)"
(mouseAndKeyboard isNil or:[mouseAndKeyboard size > 0]) ifTrue:[
self flushUserEventsFor:nil
].
"Modified: / 20.6.1998 / 16:40:02 / cg"
!
flushUserEventsFor:aView
"throw away all pending user events for aView (i.e. key & button stuff),
or for any view, if the argument is nil."
self
flushEventsFor:aView inQueue:mouseAndKeyboard
where:[:event | event isUserEvent]
"Modified: / 20.6.1998 / 16:40:09 / cg"
! !
!WindowSensor methodsFor:'event processing'!
buttonMotion:state x:x y:y view:aView
"mouse was moved - this is sent from the device (Display)"
|args ev|
"/ update my idea of shift/alt/ctrl pressed information
self updateModifierStateFrom:state device:(aView graphicsDevice).
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
"
self criticalUserEventQueueAccess:[
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
]
]
]
]
].
ev := WindowEvent buttonEvent
for:aView
type:#buttonMotion:x:y:
arguments:args.
ev hasShift:shiftDown ctrl:ctrlDown alt:altDown meta:metaDown
button1:leftButtonDown button2:middleButtonDown button3:rightButtonDown.
self pushEvent:ev.
"Modified: / 6.6.1998 / 21:09:14 / cg"
!
buttonMultiPress:button x:x y:y view:aView
"mouse button was pressed - this is sent from the device (Display)"
|ev|
self button:button inView:aView state:true.
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
].
ev := WindowEvent buttonEvent
for:aView
type:#buttonMultiPress:x:y:
arguments:(Array with:button with:x with:y).
ev hasShift:shiftDown ctrl:ctrlDown alt:altDown meta:metaDown
button1:leftButtonDown button2:middleButtonDown button3:rightButtonDown.
self pushEvent:ev.
"Modified: / 21.5.1998 / 00:20:40 / cg"
!
buttonPress:button x:x y:y view:aView
"mouse button was pressed - this is sent from the device (Display)"
|ev|
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
].
ev := WindowEvent buttonEvent
for:aView
type:#buttonPress:x:y:
arguments:(Array with:button with:x with:y).
ev hasShift:shiftDown ctrl:ctrlDown alt:altDown meta:metaDown
button1:leftButtonDown button2:middleButtonDown button3:rightButtonDown.
self pushEvent:ev.
"Modified: / 21.5.1998 / 00:20:44 / cg"
!
buttonRelease:button x:x y:y view:aView
"mouse button was released- this is sent from the device (Display)"
|ev|
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
].
ev := WindowEvent buttonEvent
for:aView
type:#buttonRelease:x:y:
arguments:(Array with:button with:x with:y).
ev hasShift:shiftDown ctrl:ctrlDown alt:altDown meta:metaDown
button1:leftButtonDown button2:middleButtonDown button3:rightButtonDown.
self pushEvent:ev.
"Modified: / 21.5.1998 / 00:21:19 / cg"
!
clientMessage:type format:format eventData:data view:aView
"some other data sent to a view.
This is an X-specific event."
self pushEvent:(WindowEvent
clientEvent
for:aView
type:#clientMessage:format:eventData:
arguments:(Array with:type with:format with:data)).
"Created: / 4.4.1997 / 17:51:08 / cg"
"Modified: / 21.5.1998 / 00:20:56 / cg"
!
configureX:x y:y width:w height:h view:aView
"a views size or position has changed - this is sent from the device (Display)"
aView superView notNil ifTrue:[
"/ this is a configure event for a subView
"/ I guess, this resulted from a resize of
"/ myself (are there any windowManagers which resize subviews ?)
"/ Therefore, ignore it here.
"/ This also fixed problems due to late-arriving configure events,
"/ in case of a resized view, which was resized before.
"/ Without the return below, we need a flushConfigureEvents entry here,
"/ to be invoked whenever a subview is resized / repositioned.
^ self
].
"/
"/ experimental: only queue one confif event (WIN32 speedup)
"/
damage size ~~ 0 ifTrue:[
damage do:[:aDamage |
aDamage notNil ifTrue:[
aDamage type == #configureX:y:width:height: ifTrue:[
aDamage view == aView ifTrue:[
aDamage
arguments:(Array with:x with:y with:w with:h).
^ false
]
]
].
]
].
self pushDamageEvent:(WindowEvent
for:aView
type:#configureX:y:width:height:
arguments:(Array with:x with:y with:w with:h)).
"Modified: / 8.12.1997 / 19:16:12 / cg"
!
coveredBy:sibling view:aView
"aView was covered by one of its siblings - this is sent from the device (Display)"
self pushDamageEvent:(WindowEvent
for:aView
type:#coveredBy:
arguments:(Array with:sibling)).
"Modified: 18.1.1997 / 14:18:32 / cg"
!
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.
self pushDamageEvent:(WindowEvent
for:aView
type:#destroyed).
"Modified: 18.1.1997 / 14:18:19 / cg"
!
dropMessage:dropType data:dropValue view:aView
"a drop sent to a view. The dropType is a symbolic specifier,
which may be ignored, since the dropValue has already been
converted into an ST/X dropObject."
self pushEvent:(WindowEvent
for:aView
type:#dropMessage:data:
arguments:(Array with:dropType with:dropValue)).
"Created: 4.4.1997 / 18:13:41 / cg"
"Modified: 4.4.1997 / 18:55:25 / cg"
!
exposeX:left y:top width:width height:height view:aView
"an expose event arrived - this is sent from the device (Display)"
ignoreExposeEvents ~~ true ifTrue:[
self addDamage:(Rectangle left:left top:top width:width height:height)
view:aView
wakeup:true.
] ifFalse:[
'ignored expose' printCR
]
"Modified: / 9.11.1998 / 14:23:01 / cg"
!
focusInView:aView
"view got input focus - this is sent from the device (Display)"
self pushEvent:(WindowEvent
for:aView
type:#focusIn).
"Modified: 18.1.1997 / 14:07:01 / cg"
!
focusOutView:aView
"view lost input focus - this is sent from the device (Display)"
self pushEvent:(WindowEvent
for:aView
type:#focusOut).
"Modified: 18.1.1997 / 14:07:09 / cg"
!
graphicsExposeX:left y:top width:width height:height final:final view:aView
"a graphic expose event arrived - this is sent from the device (Display)"
"/ this is also a possible response to a scroll operation
"/ (if an expose is pending)
final ifTrue:[
(catchExpose includes:aView) ifTrue:[
gotExpose add:aView.
exposeEventSemaphore signalForAll
] ifFalse:[
'WSensor [warning]: got exposeEvent for non-catching view:' infoPrint. aView infoPrintCR
]
].
self addDamage:(left @ top extent:width @ height) view:aView wakeup:false.
"Modified: 23.1.1997 / 22:15:53 / cg"
!
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 #UserAbort) >
|xlatedKey group process ev|
self key:key state:true.
"/ bail out of a popUpView with ctrl-escape
"/ (useful to avoid total lock of system with non-functioning grabbing opUpView)
(key == #Escape) ifTrue:[
aView isPopUpView ifTrue:[
ctrlDown ifTrue:[
aView device ungrabPointer.
aView device ungrabKeyboard.
aView destroy.
^ self
]
]
].
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 graphicsDevice translateKey:key forView:aView.
] 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 errorPrintCR.
Smalltalk copyrightString errorPrintCR.
].
(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])
or:[((xlatedKey == #UserAbort) and:[ControlYEnabled])]) ifTrue:[
"
Special handling for
Ctrl-C: interrupt the underlying process.
and:
Ctrl-Y: raise abortSignal 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:[
(xlatedKey == #UserAbort) ifTrue:[
process interruptWith:[:where | AbortSignal raise]
] ifFalse:[
process interruptWith:[:where | process userInterruptIn:where]
]
]
].
^ self
].
ignoreUserInput == true ifTrue:[
^ self
].
ev := WindowEvent keyboardEvent
for:aView
type:#keyPress:x:y:
arguments:(Array with:xlatedKey with:x with:y).
ev rawKey:key.
ev hasShift:shiftDown ctrl:ctrlDown alt:altDown meta:metaDown
button1:leftButtonDown button2:middleButtonDown button3:rightButtonDown.
self pushEvent:ev.
"Modified: / 4.12.1998 / 15:35:32 / cg"
!
keyRelease:key x:x y:y view:aView
"key was released - this is sent from the device (Display)."
|xlatedKey ev|
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 graphicsDevice translateKey:key forView:aView.
] ifFalse:[
xlatedKey := key.
].
xlatedKey isNil ifTrue:[^ self].
ev := WindowEvent keyboardEvent
for:aView
type:#keyRelease:x:y:
arguments:(Array with:xlatedKey with:x with:y).
ev rawKey:key.
ev hasShift:shiftDown ctrl:ctrlDown alt:altDown meta:metaDown
button1:leftButtonDown button2:middleButtonDown button3:rightButtonDown.
self pushEvent:ev.
"Modified: 13.8.1997 / 22:19:22 / cg"
!
mappedView:aView
"view was mapped (from window manager) - this is sent from the device (Display)"
self flushExposeEventsFor:aView.
self pushDamageEvent:(WindowEvent
for:aView
type:#mapped).
"Modified: / 16.2.1998 / 13:20:41 / cg"
!
noExposeView:aView
"an noexpose event arrived - this is sent from the device (Display)"
(catchExpose includes:aView) ifTrue:[
gotExpose add:aView.
exposeEventSemaphore signalForAll
] ifFalse:[
'WSensor [warning]: got noExpose for non-catching view:' infoPrint. aView infoPrintCR
]
!
pasteFromClipBoard:something view:aView
"a clipboard paste - this is handled like a user event"
self pushEvent:(WindowEvent
for:aView
type:#pasteFromClipBoard:
arguments:(Array with:something)).
"Modified: 18.1.1997 / 14:07:25 / cg"
"Created: 13.2.1997 / 13:40:24 / cg"
!
pointerEnter:state x:x y:y view:aView
"mouse cursor was moved into the view - this is sent from the device (Display)"
|ev|
"/ update my idea of shift/alt/ctrl pressed information
self updateModifierStateFrom:state device:(aView graphicsDevice).
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]
].
ev := WindowEvent inputEvent
for:aView
type:#pointerEnter:x:y:
arguments:(Array with:state with:x with:y).
ev hasShift:shiftDown ctrl:ctrlDown alt:altDown meta:metaDown
button1:leftButtonDown button2:middleButtonDown button3:rightButtonDown.
self pushEvent:ev.
"Modified: 13.8.1997 / 23:04:09 / cg"
!
pointerLeave:state view:aView
"mouse cursor was moved out of the view - this is sent from the device (Display)"
|ev|
"/ update my idea of shift/alt/ctrl pressed information
self updateModifierStateFrom:state device:(aView graphicsDevice).
EventListener notNil ifTrue:[
(EventListener pointerLeave:state view:aView) ifTrue:[^ self]
].
eventListener notNil ifTrue:[
(eventListener pointerLeave:state view:aView) ifTrue:[^ self]
].
ev := WindowEvent inputEvent
for:aView
type:#pointerLeave:
arguments:(Array with:state).
ev hasShift:shiftDown ctrl:ctrlDown alt:altDown meta:metaDown
button1:leftButtonDown button2:middleButtonDown button3:rightButtonDown.
self pushEvent:ev.
"Modified: 13.8.1997 / 23:04:13 / cg"
!
saveAndTerminateView:aView
"view should save & terminate (from window manager) - this is sent from the device (Display)"
self flushEventsFor:aView.
self pushDamageEvent:(WindowEvent
for:aView
type:#saveAndTerminate).
"Modified: 18.1.1997 / 14:17:37 / cg"
!
terminateView:aView
"view should terminate (from window manager) - this is sent from the device (Display)"
self flushEventsFor:aView.
self pushDamageEvent:(WindowEvent
for:aView
type:#terminate).
"Modified: 18.1.1997 / 14:17:24 / cg"
!
unmappedView:aView
"view was unmapped (from window manager) - this is sent from the device (Display)"
self flushExposeEventsFor:aView.
self pushDamageEvent:(WindowEvent
for:aView
type:#unmapped).
"Modified: / 16.2.1998 / 13:20:37 / cg"
! !
!WindowSensor methodsFor:'event processing - private'!
button:button inView:aView state:onOrOff
"update the state of the xxxButtonDown flags"
|physicalButton|
physicalButton := aView graphicsDevice buttonTranslation keyAtValue:button ifAbsent:button.
(physicalButton == 1) ifTrue:[
leftButtonDown := onOrOff.
^ self
].
(physicalButton == 2) ifTrue:[
middleButtonDown := onOrOff.
^ self
].
(physicalButton == 3) ifTrue:[
rightButtonDown := onOrOff.
^ self
].
"Modified: 21.10.1996 / 11:47:35 / cg"
!
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 == #Ctrl
or:[key == #'Ctrl_R' or:[key == #'Ctrl_L']]) ifTrue:[
^ true
].
(key == #Control
or:[key == #'Control_R' or:[key == #'Control_L']]) ifTrue:[
^ true
].
^ false
"Modified: / 22.8.1998 / 02:33:46 / 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 = #Ctrl
or:[key = #'Ctrl_R' or:[key = #'Ctrl_L']]) ifTrue:[
ctrlDown := onOrOff.
^ self
].
(key = #Control
or:[key = #'Control_R' or:[key = #'Control_L']]) ifTrue:[
ctrlDown := onOrOff.
^ self
].
"Modified: / 22.8.1998 / 02:33:04 / cg"
!
notifyEventArrival:aView
"an event arrived - if there is an eventSemaphore,
signal it, to wake up any windowGroup process"
(catchExpose includesIdentical:aView) ifTrue:[
"
dont wake up, if we are currently waiting for an expose
but remember arrival of something.
"
gotOtherEvent add:aView.
^ self
].
eventSemaphore notNil ifTrue:[
"/ eventSemaphore signal
"/ can get along with a single trigger;
"/ because processEvents will read all events
eventSemaphore signalOnce
]
"Modified: 8.2.1997 / 12:01:48 / cg"
!
updateModifierStateFrom:stateIn device:aDevice
"this updates the modifier key-states.
Called privately when pointer enters a view."
|state|
"/ 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"
"/ state := aDevice buttonStates.
state := stateIn.
shiftDown := (state bitAnd:(aDevice shiftMask)) ~~ 0.
ctrlDown := (state bitAnd:(aDevice controlMask)) ~~ 0.
metaDown := (state bitAnd:(aDevice metaModifierMask)) ~~ 0.
altDown := (state bitAnd:(aDevice altModifierMask)) ~~ 0.
leftButtonDown := (state bitAnd:(aDevice leftButtonStateMask)) ~~ 0.
middleButtonDown := (state bitAnd:(aDevice middleButtonStateMask)) ~~ 0.
rightButtonDown := (state bitAnd:(aDevice rightButtonStateMask)) ~~ 0.
"Created: / 27.2.1996 / 14:54:38 / cg"
"Modified: / 8.9.1998 / 15:11:44 / cg"
! !
!WindowSensor methodsFor:'event queue'!
addDamage:aRectangle view:aView
"{ Pragma: +optSpeed }"
"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."
^ self addDamage:aRectangle view:aView wakeup:true
"Modified: 28.5.1996 / 21:52:47 / cg"
!
addDamage:aRectangle view:aView wakeup:doWakeup
"{ Pragma: +optSpeed }"
"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.
Returns true, if a new event has been added to the queue, false if it
was optimized away."
|ret|
ret := false.
self criticalDamageEventQueueAccess:[
(self basicAddDamage:aRectangle view:aView)
ifTrue:[
doWakeup ifTrue:[
self notifyEventArrival:aView.
ret := true
].
].
].
^ ret
"Created: / 28.5.1996 / 21:51:16 / cg"
"Modified: / 6.6.1998 / 21:09:06 / cg"
!
basicAddDamage:aRectangle view:aView
"{ Pragma: +optSpeed }"
"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.
Returns true, if a new event has been added to the queue, false if it
was optimized away."
|temp index newEvent r fullRedraw
aDamage ev2 dRect stopSearch
count "{ Class: SmallInteger }"
sz "{ Class: SmallInteger }"
firstInteresting
lastInteresting "{ Class: SmallInteger }"
idx "{ Class: SmallInteger }"
rL "{ Class: SmallInteger }"
rT "{ Class: SmallInteger }"
rB "{ Class: SmallInteger }"
rR "{ Class: SmallInteger }"
dL "{ Class: SmallInteger }"
dR "{ Class: SmallInteger }"
dT "{ Class: SmallInteger }"
dB "{ Class: SmallInteger }"
minX "{ Class: SmallInteger }"
minY "{ Class: SmallInteger }"
maxX "{ Class: SmallInteger }"
maxY "{ Class: SmallInteger }"
t "{ Class: SmallInteger }"|
r := aRectangle.
(fullRedraw := 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
"
fullRedraw ifTrue:[
firstInteresting := 1.
lastInteresting := sz.
] ifFalse:[
count := 0.
firstInteresting := nil.
"/ must search backward, break search with first
"/ non-Expose (i.e. mapped/unmapped)
stopSearch := false.
idx := sz.
[(idx > 0) and:[stopSearch not]] whileTrue:[
aDamage := damage at:idx.
aDamage notNil ifTrue:[
aDamage view == aView ifTrue:[
aDamage isDamage ifTrue:[
((aDamage rectangle) contains:r) ifTrue:[
^ false
].
count := count + 1.
lastInteresting := idx.
firstInteresting isNil ifTrue:[
firstInteresting := idx
]
] ifFalse:[
"/ if its a map/unmap, we can forget
"/ any older damage event for this view ...
(aDamage isUnmapEvent or:[aDamage isMapEvent]) ifTrue:[
idx := idx - 1.
[idx > 0] whileTrue:[
ev2 := damage at:idx.
ev2 notNil ifTrue:[
ev2 isDamage ifTrue:[
ev2 view == aView ifTrue:[
damage at:idx put:nil
]
]
].
idx := idx - 1.
].
stopSearch := true
].
]
]
].
idx := idx - 1.
].
].
"
are there any damages for this view in the queue ?
"
firstInteresting notNil 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 ...)
"
(fullRedraw or:[count > 10]) ifTrue:[
minX := r left. minY := r top.
maxX := r right. maxY := r bottom.
firstInteresting to:lastInteresting by:-1 do:[:i |
aDamage := damage at:i.
aDamage notNil ifTrue:[
aDamage isDamage ifTrue:[
(aDamage view) == aView ifTrue:[
dRect := aDamage rectangle.
(t := dRect left) < minX ifTrue:[minX := t].
(t := dRect top) < minY ifTrue:[minY := t].
(t := dRect right) > maxX ifTrue:[maxX := t].
(t := dRect bottom) > maxY ifTrue:[maxY := t].
damage at:i put:nil.
].
].
]
].
newEvent := WindowEvent
damageFor:aView
rectangle:(minX@minY corner:maxX@maxY).
damage add:newEvent.
^ true
].
"
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 by:-1 do:[:i |
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 20 events, reorganize the queue
"/ (doing this for every 20 removes only avoids excessive
"/ reorganization of the input queue)
"/ "
"/ count > 20 ifTrue: [
"/ temp := OrderedCollection new:(sz - count + 1).
"/ index := 1.
"/ 1 to:sz do:[:idx |
"/ aDamage := damage at:idx.
"/ aDamage notNil ifTrue: [
"/ temp add:aDamage.
"/ ]
"/ ].
"/ damage := temp
"/ ].
].
].
newEvent := WindowEvent damageFor:aView rectangle:r.
damage add:newEvent.
^ true
"Created: / 8.2.1997 / 12:07:06 / cg"
"Modified: / 27.2.1998 / 01:49:06 / cg"
!
damage
"return the damage event list"
^ damage.
"Modified: 18.1.1997 / 14:11:08 / cg"
!
nextDamage
"retrieve the next damage (either expose or resize event)
or nil, if there is none. Remove it from the queue."
|d foundOne|
damage size == 0 ifTrue:[^ nil].
foundOne := false.
[foundOne] whileFalse:[
"
be careful: events are inserted at higher prio ...
"
self criticalDamageEventQueueAccess:[
damage size == 0 ifTrue:[
foundOne := true
] ifFalse:[
d := damage removeFirst.
foundOne := d notNil.
]
]
].
^ d
"Modified: / 6.6.1998 / 21:10:27 / cg"
!
nextDamageEventFor:aViewOrNil
"retrieve the next damage event for aView (or any view if nil).
Return if there are no damage events.
Remove it from the queue."
damage size == 0 ifTrue:[^ nil].
"
be careful: events are inserted at higher prio ...
"
self criticalDamageEventQueueAccess:[
damage keysAndValuesDo:[:idx :anEvent |
anEvent notNil ifTrue:[
(aViewOrNil isNil or:[anEvent view == aViewOrNil]) ifTrue:[
damage at:idx put:nil.
^ anEvent
].
].
]
].
^ nil
"Modified: / 6.6.1998 / 21:10:46 / cg"
"Created: / 3.12.1998 / 13:41:49 / cg"
!
nextEvent
"retrieve the next event or nil, if there is none.
Remove it from the queue."
|e foundOne|
mouseAndKeyboard size == 0 ifTrue:[^ nil].
foundOne := false.
[foundOne] whileFalse:[
"
be careful: events are inserted at higher prio ...
"
self criticalUserEventQueueAccess:[
mouseAndKeyboard size == 0 ifTrue:[
foundOne := true
] ifFalse:[
e := mouseAndKeyboard removeFirst.
foundOne := e notNil.
]
]
].
^ e
"Modified: / 6.6.1998 / 21:10:39 / cg"
!
nextExposeEventFor:aView
"retrieve the next expose event for aView (or any view if nil).
Return if there are no expose events.
Remove it from the queue."
damage size == 0 ifTrue:[^ nil].
"
be careful: events are inserted at higher prio ...
"
self criticalDamageEventQueueAccess:[
damage keysAndValuesDo:[:idx :anEvent |
anEvent notNil ifTrue:[
anEvent isDamage ifTrue:[
(aView isNil or:[anEvent view == aView]) ifTrue:[
damage at:idx put:nil.
^ anEvent
]
].
].
]
].
^ nil
"Created: / 21.5.1996 / 17:20:54 / cg"
"Modified: / 6.6.1998 / 21:10:46 / 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|
mouseAndKeyboard size == 0 ifTrue:[^ nil].
[e isNil] whileTrue:[
"
be careful: events are inserted at higher prio ...
"
self criticalUserEventQueueAccess:[
mouseAndKeyboard size == 0 ifTrue:[^ nil].
e := mouseAndKeyboard first.
e isNil ifTrue:[
mouseAndKeyboard removeFirst
].
]
].
^ e
"Modified: / 6.6.1998 / 21:10:51 / cg"
!
pushDamageEvent:anEvent
"put an event into the damage queue
- this is not meant for public use"
self criticalDamageEventQueueAccess:[
damage addLast:anEvent.
].
self notifyEventArrival:anEvent view
"Created: / 18.1.1997 / 14:16:45 / cg"
"Modified: / 6.6.1998 / 21:10:56 / cg"
!
pushEvent:anEvent
"put an event into the queue - this can also be sent by
applications and allows simulation of events
(implementation of recorders & playback)
or asynchronous communication between view applications
(by sending arbitrary events, which leads to a message sent,
when the target windowGroups process is rescheduled)."
|v|
v := anEvent view.
self criticalUserEventQueueAccess:[
mouseAndKeyboard addLast:anEvent.
].
self notifyEventArrival:v
"Created: / 18.9.1995 / 22:37:57 / claus"
"Modified: / 18.6.1998 / 09:27:56 / cg"
! !
!WindowSensor methodsFor:'event simulation'!
forwardKeyEventsTo:aView
"remove all keyboard events and send them to aViews sensor instead"
1 to:mouseAndKeyboard size do:[:i |
|anEvent|
anEvent := mouseAndKeyboard at:i.
anEvent notNil ifTrue:[
anEvent isKeyEvent ifTrue:[
anEvent view:aView.
aView sensor pushEvent:anEvent.
mouseAndKeyboard at:i put:nil
]
]
].
"Modified: 18.1.1997 / 14:05:02 / cg"
!
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 pushUserEvent:#pointerEnter:x:y: for:b withArguments:#(0 1 1).
(Delay forSeconds:1) wait.
b sensor pushUserEvent:#buttonPress:x:y: for:b withArguments:#(1 1 1).
(Delay forSeconds:2) wait.
b sensor pushUserEvent:#buttonRelease:x:y: for:b withArguments:#(1 1 1).
(Delay forSeconds:1) wait.
b sensor pushUserEvent:#pointerLeave: for:b withArguments:#(0).
"
"
|b|
b := Button label:'test'.
b open.
(Delay forSeconds:5) wait.
b sensor pushUserEvent:#fooBar for:b withArguments:#().
"
"
|b|
b := Button label:'test'.
b open.
(Delay forSeconds:3) wait.
b sensor pushUserEvent:#disable for:b withArguments:#().
"
"Modified: 4.1.1997 / 13:53:01 / cg"
! !
!WindowSensor methodsFor:'initialization'!
initialize
"initialize the event queues to empty"
damageEventAccessLock := Semaphore forMutualExclusion.
damageEventAccessLock name:'WSensor ev-q damageEventAccessLock'.
userEventAccessLock := Semaphore forMutualExclusion.
userEventAccessLock name:'WSensor ev-q userEventAccessLock'.
damage := OrderedCollection new.
mouseAndKeyboard := OrderedCollection new.
gotExpose := IdentitySet new.
catchExpose := IdentitySet new.
gotOtherEvent := IdentitySet new.
exposeEventSemaphore := Semaphore new name:'WSensor exposeSema'.
compressMotionEvents := translateKeyboardEvents := true.
ignoreUserInput := false.
shiftDown := ctrlDown := altDown := metaDown := false.
leftButtonDown := middleButtonDown := rightButtonDown := false.
"Modified: / 6.6.1998 / 21:14:49 / cg"
!
reinitialize
"called when an image is restarted;
reinitialize the event queues to empty; leave other setup as-is"
self flushUserEvents.
self flushExposeEvents.
gotExpose := IdentitySet new.
catchExpose := IdentitySet new.
gotOtherEvent := IdentitySet new.
exposeEventSemaphore := Semaphore new name:'WSensor exposeSema'.
shiftDown := ctrlDown := altDown := metaDown := false.
leftButtonDown := middleButtonDown := rightButtonDown := false.
"Modified: 18.1.1997 / 15:30:23 / cg"
! !
!WindowSensor methodsFor:'queries - event queue'!
damageCount
"return the number of pending damage events (i.e. expose or resize)"
^ damage size
"Modified: / 2.4.1997 / 14:14:01 / cg"
"Created: / 5.4.1998 / 11:35:04 / cg"
!
eventPending
"return true, if either damage or events are pending"
mouseAndKeyboard size ~~ 0 ifTrue:[^ true].
^ damage size ~~ 0
!
hasButtonEventFor:aView
"return true, if any button events are pending.
If the argument, aView is nil, the information is regarding any
view (i.e. is there a button event for any of my views);
otherwise, the information is regarding that specific view."
(self hasButtonMotionEventFor:aView) ifTrue:[^ true].
(self hasButtonPressEventFor:aView) ifTrue:[^ true].
^ (self hasButtonReleaseEventFor:aView)
"Created: 1.11.1996 / 17:02:23 / cg"
"Modified: 1.11.1996 / 17:12:03 / cg"
!
hasButtonMotionEventFor: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 regarding that specific view."
^ self hasEvent:#buttonMotion:x:y: orPendingDeviceEvent:#buttonMotion for:aView
"Created: 1.11.1996 / 17:04:01 / cg"
!
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 buttonPress event for any of my views);
otherwise, the information is regarding that specific view."
^ self hasEvent:#buttonPress:x:y: orPendingDeviceEvent:#buttonPress for:aView
"Created: 1.11.1996 / 17:05:10 / cg"
"Modified: 1.11.1996 / 17:11:09 / cg"
!
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 buttonrelease event for any of my views);
otherwise, the information is regarding that specific view."
^ self hasEvent:#buttonRelease:x:y: orPendingDeviceEvent:#buttonRelease for:aView
"Created: 1.11.1996 / 17:05:26 / cg"
"Modified: 1.11.1996 / 17:11:18 / cg"
!
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 configure event for any of my views);
otherwise, the information is regarding that specific view."
^ self hasEvent:#configureX:y:width:height: orPendingDeviceEvent:#structureNotify for:aView
"Modified: 1.11.1996 / 17:11:27 / cg"
!
hasDamage
"return true, if any damage events (i.e. expose or resize) are pending.
Since this is often invoked by ST-80 classes to poll the sensor,
a yield is done here to avoid a busy wait blocking other processes."
Processor yield.
^ damage size ~~ 0
"Modified: 2.4.1997 / 14:14:01 / cg"
!
hasDamageFor:aView
"return true, if any damage events (i.e. expose or resize)
are pending for aView"
damage size ~~ 0 ifTrue:[
damage do:[:aDamage |
aDamage notNil ifTrue:[
aDamage view == aView ifTrue:[^ true].
].
]
].
^ false
"Modified: 21.5.1996 / 17:15:09 / cg"
!
hasEvent:type for:aView
"return true, if a specific event is pending in my queues.
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 an event for any of my views);
otherwise, the information is regarding to that specific view."
mouseAndKeyboard size ~~ 0 ifTrue:[
mouseAndKeyboard do:[:anEvent |
anEvent notNil ifTrue:[
(aView isNil or:[anEvent view == aView]) ifTrue:[
(type isNil or:[anEvent type == type]) ifTrue:[^ true].
]
].
]
].
damage size ~~ 0 ifTrue:[
damage do:[:anEvent |
anEvent notNil ifTrue:[
(aView isNil or:[anEvent view == aView]) ifTrue:[
(type isNil or:[anEvent type == type]) ifTrue:[^ true].
]
].
]
].
^ false
"Created: / 10.6.1998 / 17:33:46 / cg"
"Modified: / 18.6.1998 / 09:29:18 / cg"
!
hasEvent:type for:aView withArguments:args
"return true, if a specific event is pending in my queues.
Type is the type of event, args are the arguments.
If the argument, aView is nil, the information is regarding any
view (i.e. is there an event for any of my views);
otherwise, the information is regarding to that specific view."
^ self
hasEvent:type
for:aView
withMatchingArguments:[:evArgs | evArgs = args]
!
hasEvent:type for:aView withMatchingArguments:argMatchBlock
"return true, if a matching event is pending in my queues.
Type is the type of event, matchBlock is a block which gets the event args
and should return true.
If the argument, aView is nil, the information is regarding any
view (i.e. is there an event for any of my views);
otherwise, the information is regarding to that specific view."
mouseAndKeyboard size ~~ 0 ifTrue:[
mouseAndKeyboard do:[:anEvent |
anEvent notNil ifTrue:[
(aView isNil or:[anEvent view == aView]) ifTrue:[
anEvent type == type ifTrue:[
(argMatchBlock value:anEvent arguments) ifTrue:[
^ true
].
]
]
].
]
].
damage size ~~ 0 ifTrue:[
damage do:[:anEvent |
anEvent notNil ifTrue:[
(aView isNil or:[anEvent view == aView]) ifTrue:[
anEvent type == type ifTrue:[
(argMatchBlock value:anEvent arguments) ifTrue:[
^ true
]
].
]
].
]
].
^ false
"Modified: 1.11.1996 / 17:11:47 / cg"
"Created: 4.1.1997 / 14:00:29 / cg"
!
hasEvent:type orPendingDeviceEvent:dType for:aView
"return true, if a specific event is pending in a queue
or in the devices event queue.
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 an event for any of my views);
otherwise, the information is regarding to that specific view."
"/ look in my queues
(self hasEvent:type for:aView) ifTrue:[^ true].
aView notNil ifTrue:[
"/ ask the device if it has something pending
^ aView graphicsDevice eventPending:dType for:aView id
].
^ false
"Modified: / 10.6.1998 / 17:34:51 / cg"
!
hasEvents
"return true, if any mouse/keyboard events are pending"
^ mouseAndKeyboard size ~~ 0
!
hasExposeEventFor:aView
"return true, if any exposure events are pending for aView"
damage size ~~ 0 ifTrue:[
damage do:[:aDamage |
aDamage notNil ifTrue:[
aDamage isDamage ifTrue:[
(aView isNil
or:[aDamage view == aView]) ifTrue:[^ true].
]
].
]
].
^ false
"Modified: 21.5.1996 / 17:13:09 / cg"
"Created: 1.11.1996 / 17:05:41 / cg"
!
hasKeyEventFor:aView
"return true, if any key (press or release) events are pending.
If the argument, aView is nil, the information is regarding any
view (i.e. is there a key event for any of my views);
otherwise, the information is regarding that specific view."
(self hasKeyPressEventFor:aView) ifTrue:[^ true].
^ self hasKeyReleaseEventFor:aView
"Created: 1.11.1996 / 17:08:03 / cg"
"Modified: 1.11.1996 / 17:11:55 / cg"
!
hasKeyPressEventFor: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 keyPress event for any of my views);
otherwise, the information is regarding that specific view."
^ self hasEvent:#keyPress:x:y: orPendingDeviceEvent:#keyPress for:aView
"Created: 1.11.1996 / 17:05:58 / cg"
"Modified: 1.11.1996 / 17:12:10 / cg"
!
hasKeyReleaseEventFor:aView
"return true, if any keyRelease events are pending.
If the argument, aView is nil, the information is regarding any
view (i.e. is there a keyRelease event for any of my views);
otherwise, the information is regarding that specific view."
^ self hasEvent:#keyRelease:x:y: orPendingDeviceEvent:#keyRelease for:aView
"Created: 1.11.1996 / 17:06:34 / cg"
"Modified: 1.11.1996 / 17:12:15 / cg"
!
hasUserEvent:type for:aView
"return true, if a specific event is pending in my user event queue.
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 an event for any of my views);
otherwise, the information is regarding to that specific view."
mouseAndKeyboard size ~~ 0 ifTrue:[
mouseAndKeyboard do:[:anEvent |
anEvent notNil ifTrue:[
(aView isNil or:[anEvent view == aView]) ifTrue:[
(type isNil or:[anEvent type == type]) ifTrue:[^ true].
]
].
]
].
^ false
"Created: / 17.6.1998 / 12:55:54 / cg"
"Modified: / 18.6.1998 / 08:57:00 / cg"
!
hasUserEventFor:aView
"return true, if any user event (i.e. key or button events) are pending.
If the argument, aView is nil, the information is regarding any
view (i.e. is there a user event for any of my views);
otherwise, the information is regarding that specific view."
(self hasKeyEventFor:aView) ifTrue:[^ true].
^ (self hasButtonEventFor:aView)
"Created: 1.11.1996 / 17:08:50 / cg"
"Modified: 1.11.1996 / 17:12:21 / cg"
!
motionEventPending
"return true, if any buttonMotion events are pending."
^ self hasButtonMotionEventFor:nil
"Created: 24.3.1996 / 20:09:55 / cg"
"Modified: 1.11.1996 / 17:04:43 / cg"
!
userEventCount
"return the number of pending user events"
^ mouseAndKeyboard size
"Modified: / 21.7.1998 / 18:52:19 / cg"
"Created: / 21.7.1998 / 19:36:04 / cg"
! !
!WindowSensor methodsFor:'queries - key & button state'!
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."
^ leftButtonDown or:[middleButtonDown or:[rightButtonDown]]
"Modified: 21.10.1996 / 11:37:31 / cg"
!
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
!
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
!
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:'queries - pointer'!
cursorPoint
"ST-80 compatibility:
return the position of the mouse pointer on the current display
(in screen coordinates)"
^ self class cursorPoint
!
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
!
mousePoint
"ST-80 compatibility:
return the position of the mouse pointer on the current display
(in screen coordinates)"
^ self cursorPoint
! !
!WindowSensor methodsFor:'special'!
catchExposeFor:aView
"start catching noExpose events (must be done BEFORE a bitblt,
to prepare for the exposeEventSemaphore to be signalled when
the noExpose event arrives)."
"/ this is only needed for X ...
aView device scrollsAsynchronous ifFalse:[
^ self
].
(catchExpose includes:aView) ifTrue:[
('WSensor [warning]: already catching (for ' , aView printString , ')') errorPrintCR.
Delay waitForMilliseconds:100.
(catchExpose includes:aView) ifTrue:[
('WSensor [warning]: still catching (for ' , aView printString , ')') errorPrintCR.
"/ wake the other one
gotExpose add:aView.
exposeEventSemaphore signalForAll.
Delay waitForMilliseconds:100.
].
].
[
gotOtherEvent remove:aView ifAbsent:nil.
gotExpose remove:aView ifAbsent:nil.
catchExpose add:aView.
] valueUninterruptably.
!
pollForActivity
"ST-80 compatibility: wait for some activity (i.e. poll for an event) "
"/ should add a buttonStateChangeSemaphore and wait on this ...
"/ Delay waitForSeconds:0.01.
Processor yield.
"Modified: 12.2.1997 / 12:46:09 / cg"
!
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:[
self pollForActivity
].
"Modified: 10.2.1997 / 13:30:38 / cg"
!
waitClickButton
"ST-80 compatibility: wait until any mouse button is pressed & released again.
Do not use this in your applications; polling the sensor is
bad style."
self waitButton.
^self waitNoButton
"Created: 10.2.1997 / 13:31:09 / cg"
!
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)"
|blocked lostExpose device stopPoll endPollTime pollDelay|
device := aView graphicsDevice.
"/ this is only needed for X ...
device scrollsAsynchronous ifFalse:[
gotExpose remove:aView ifAbsent:nil.
catchExpose remove:aView ifAbsent:nil.
^ self
].
blocked := true.
[
aView flush.
Processor activeProcessIsSystemProcess ifTrue:[
device platformName = 'WIN32' ifTrue:[
pollDelay := 1.
] ifFalse:[
pollDelay := 3.
].
endPollTime := AbsoluteTime now addSeconds:pollDelay.
stopPoll := false.
"/
"/ cannot really suspend, if its a systemProcess
"/ must poll for the event
"/
[(gotExpose includes:aView) or:[stopPoll]] whileFalse:[
(device exposeEventPendingFor:aView id withSync:true) ifTrue:[
device dispatchExposeEventFor:aView id.
].
stopPoll := (AbsoluteTime now > endPollTime).
Processor yield.
]
] ifFalse:[
lostExpose := 1.
"
block interrupt here, to resolve race between
testing gotExpose and the semaphore, which is woken up
with #signalForAll.
"
blocked := OperatingSystem blockInterrupts.
[ (gotExpose includes:aView) or:[lostExpose > 2] ] 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:(1 * lostExpose)) isNil ifTrue:[
device flush. "/ we are paranoid
lostExpose == 1 ifTrue:[
"
you can put a comment around the following line,
if you don't like the message ...
"
('WindowSensor [info]: late expose event (' , aView printString , ')') infoPrintCR.
] ifFalse:[
'WindowSensor [warning]: lost expose event' errorPrintCR.
].
lostExpose := lostExpose + 1.
].
].
].
] valueNowOrOnUnwindDo:[
gotExpose remove:aView ifAbsent:nil.
catchExpose remove:aView ifAbsent:nil.
blocked ifFalse:[
OperatingSystem unblockInterrupts.
].
"/
"/ other incoming events have been ignored during the wait.
"/ Now handle those ...
"/
(gotOtherEvent includes:aView) ifTrue:[
gotOtherEvent remove:aView ifAbsent:nil.
].
eventSemaphore signalOnce
].
"Modified: / 20.2.1997 / 09:24:31 / stefan"
"Modified: / 9.1.1999 / 01:58:56 / 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:[
self pollForActivity
].
"Modified: 10.2.1997 / 13:30:43 / cg"
! !
!WindowSensor class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.136 1999-01-10 17:03:56 cg Exp $'
! !
WindowSensor initialize!