'From Squeak3.7alpha of 11 September 2003 [latest update: #5816] on 18 March 2004 at 3:16 pm'! "Change Set: EventSensorInterruptFix-nk Date: 18 March 2004 Author: Ned Konz CS 5784NoEventSensorProcess-ar broke the ability to break out of a tight UI loop. This CS fixes that problem by checking from time to time whether it has been too long since the last time that events were polled. It also lays the groundwork for eventual use of the input semaphore by Morphic by setting a flag if the input semaphore is actually being signaled by the VM. "! InputSensor subclass: #EventSensor instanceVariableNames: 'mouseButtons mousePosition keyboardBuffer interruptKey interruptSemaphore eventQueue inputSemaphore hadInterrupt hasInputSemaphore lastEventPoll ' classVariableNames: 'EventPollFrequency ' poolDictionaries: 'EventSensorConstants' category: 'Kernel-Processes'! !EventSensor commentStamp: 'nk 3/18/2004 14:49' prior: 0! EventSensor is a replacement for InputSensor based on a set of (optional) event primitives. An EventSensor updates its state when events are received so that all state based users of Sensor (e.g., Sensor keyboard, Sensor leftShiftDown, Sensor mouseButtons) will work exactly as before, by moving the current VM mechanisms into EventSensor itself. An optional input semaphore is part of the new design. For platforms that support true asynchronous event notification, the semaphore will be signaled to indicate pending events. On platforms that do not support asynchronous notifications about events, the UI will have to poll EventSensor periodically to read events from the VM. Instance variables: mouseButtons - mouse button state as replacement for primMouseButtons mousePosition - mouse position as replacement for primMousePt keyboardBuffer - keyboard input buffer interruptKey - currently defined interrupt key interruptSemaphore - the semaphore signaled when the interruptKey is detected eventQueue - an optional event queue for event driven applications inputProcess - the process receiving low-level events inputSemaphore - the semaphore signaled by the VM if asynchronous event notification is supported lastEventPoll - the last millisecondClockValue at which we called fetchMoreEvents hadInterrupt - true if the last call to fetchMoreEvents noticed an interrupt key hasInputSemaphore - true if my inputSemaphore has actually been signaled at least once. Class variables: EventPollFrequency - the number of milliseconds to wait between polling for more events in the userInterruptHandler. Event format: The current event format is very simple. Each event is recorded into an 8 element array. All events must provide some SmallInteger ID (the first field in the event buffer) and a time stamp (the second field in the event buffer), so that the difference between the time stamp of an event and the current time can be reported. Currently, the following events are defined: Null event ============= The Null event is returned when the ST side asks for more events but no more events are available. Structure: [1] - event type 0 [2-8] - unused Mouse event structure ========================== Mouse events are generated when mouse input is detected. Structure: [1] - event type 1 [2] - time stamp [3] - mouse x position [4] - mouse y position [5] - button state; bitfield with the following entries: 1 - yellow (e.g., right) button 2 - blue (e.g., middle) button 4 - red (e.g., left) button [all other bits are currently undefined] [6] - modifier keys; bitfield with the following entries: 1 - shift key 2 - ctrl key 4 - (Mac specific) option key 8 - Cmd/Alt key [all other bits are currently undefined] [7] - reserved. [8] - reserved. Keyboard events ==================== Keyboard events are generated when keyboard input is detected. [1] - event type 2 [2] - time stamp [3] - character code For now the character code is in Mac Roman encoding. [4] - press state; integer with the following meaning 0 - character 1 - key press (down) 2 - key release (up) [5] - modifier keys (same as in mouse events) [6] - reserved. [7] - reserved. [8] - reserved. ! !EventSensor methodsFor: 'accessing' stamp: 'nk 3/18/2004 15:03'! hasWorkingInputSemaphore "Answer whether my input semaphore is actually being signaled on input events. This will answer false until input has actually happened and signaled the semaphore." ^hasInputSemaphore! ! !EventSensor methodsFor: 'accessing' stamp: 'nk 3/18/2004 15:01'! inputSemaphore "Answer my input semaphore if it actually works; otherwise answer nil. This will answer nil until input has actually happened and signaled the semaphore." ^hasInputSemaphore ifTrue: [ inputSemaphore ] ifFalse: [ nil ]! ! !EventSensor methodsFor: 'accessing' stamp: 'nk 3/18/2004 13:21'! lastEventPoll "Answer the last clock value at which fetchMoreEvents was called." ^lastEventPoll ifNil: [ lastEventPoll _ Time millisecondClockValue ]! ! !EventSensor methodsFor: 'accessing' stamp: 'nk 3/18/2004 13:58'! processEvent: evt "Process a single event. This method is run at high priority." | type | type _ evt at: 1. "Check if the event is a user interrupt" (type = EventTypeKeyboard and:[(evt at: 4) = 0 and:[ ((evt at: 3) bitOr: ((evt at: 5) bitShift: 8)) = interruptKey]]) ifTrue:["interrupt key is meta - not reported as event" hadInterrupt _ true. ^interruptSemaphore signal]. "Store the event in the queue if there's any" type = EventTypeMouse ifTrue: [evt at: 5 put: (ButtonDecodeTable at: (evt at: 5) + 1)]. type = EventTypeKeyboard ifTrue: ["swap ctrl/alt keys" KeyDecodeTable at: { evt at: 3 . evt at: 5 } ifPresent: [:a | evt at: 3 put: a first; at: 5 put: a second]]. self queueEvent: evt. "Update state for InputSensor." EventTypeMouse = type ifTrue:[self processMouseEvent: evt]. EventTypeKeyboard = type ifTrue:[self processKeyboardEvent: evt]! ! !EventSensor methodsFor: 'initialize' stamp: 'nk 3/18/2004 14:52'! initialize "Initialize the receiver" mouseButtons := 0. mousePosition := 0 @ 0. keyboardBuffer := SharedQueue new. self setInterruptKey: (interruptKey ifNil: [$. asciiValue bitOr: 16r0800 ]). "cmd-." hadInterrupt := false. interruptSemaphore := (Smalltalk specialObjectsArray at: 31) ifNil: [Semaphore new]. self flushAllButDandDEvents. inputSemaphore := Semaphore new. hasInputSemaphore := false.! ! !EventSensor methodsFor: 'initialize' stamp: 'nk 3/18/2004 14:59'! startUp "Run the I/O process" self shutDown. self initialize. self primSetInputSemaphore: (Smalltalk registerExternalObject: inputSemaphore). super startUp. Smalltalk isMorphic ifTrue:[self flushAllButDandDEvents]. "Attempt to discover whether the input semaphore is actually being signaled." hasInputSemaphore := false. inputSemaphore initSignals. ! ! !EventSensor methodsFor: 'private' stamp: 'nk 3/18/2004 14:21'! userInterruptWatcher "Wait for user interrupts and open a notifier on the active process when one occurs. Also poll infrequently to make sure that the UI process is not been stuck. If it has been stuck, then spin the event loop so that I can detect the interrupt key." self class eventPollFrequency. "ensure not nil" self lastEventPoll. "ditto" hadInterrupt := false. [| delta | InterruptSemaphore waitTimeoutMSecs: EventPollFrequency. "Now the semaphore has either been signaled (if an interrupt) or the poll has timed out. Test the flag to see which one." hadInterrupt ifTrue: [hadInterrupt := false. Display deferUpdates: false. SoundService default shutDown. Smalltalk handleUserInterrupt] ifFalse: [delta := Time millisecondClockValue - lastEventPoll. (delta < 0 or: [delta > EventPollFrequency]) ifTrue: ["force check on rollover" self fetchMoreEvents]]] repeat! ! !EventSensor methodsFor: 'private-I/O' stamp: 'nk 3/18/2004 14:58'! fetchMoreEvents "Fetch more events from the VM" | eventBuffer type | "Reset input semaphore so clients can wait for the next events after this one." inputSemaphore isSignaled ifTrue: [ hasInputSemaphore _ true. inputSemaphore initSignals ]. eventBuffer := Array new: 8. [self primGetNextEvent: eventBuffer. type := eventBuffer at: 1. type = EventTypeNone] whileFalse: [self processEvent: eventBuffer]. "Remember the last time that I checked for events." lastEventPoll := Time millisecondClockValue! ! !EventSensor class methodsFor: 'class initialization' stamp: 'nk 3/18/2004 13:59'! eventPollFrequency ^EventPollFrequency ifNil: [ EventPollFrequency _ 500 ].! ! !EventSensor class methodsFor: 'class initialization' stamp: 'nk 3/18/2004 14:00'! eventPollFrequency: msec "Set the number of milliseconds between checking for events to msec." EventPollFrequency _ msec max: 10.! ! InputSensor subclass: #EventSensor instanceVariableNames: 'mouseButtons mousePosition keyboardBuffer interruptKey interruptSemaphore eventQueue inputSemaphore lastEventPoll hadInterrupt hasInputSemaphore' classVariableNames: 'EventPollFrequency' poolDictionaries: 'EventSensorConstants' category: 'Kernel-Processes'! !EventSensor reorganize! ('accessing' buttons eventQueue flushAllButDandDEvents flushEvents hasWorkingInputSemaphore inputSemaphore lastEventPoll mouseButtons nextEvent nextEventFromQueue nextEventSynthesized peekButtons peekEvent peekMousePt peekPosition processEvent:) ('initialize' initialize shutDown startUp) ('keyboard' primKbdNext primKbdPeek) ('mouse' createMouseEvent) ('private' flushNonKbdEvents isKbdEvent: primInterruptSemaphore: primMouseButtons primMousePt primSetInterruptKey: userInterruptWatcher) ('private-I/O' fetchMoreEvents mapButtons:modifiers: primGetNextEvent: primSetInputSemaphore: processKeyboardEvent: processMouseEvent: queueEvent:) !