'From Squeak3.7beta of ''1 April 2004'' [latest update: #5878] on 13 April 2004 at 3:59:26 pm'! "Change Set: MoreEventSensorFixes-nk (v2) Date: 13 April 2004 Author: Ned Konz This is another modification to the changes made in updates 5784NoEventSensorProcess-ar and 5866MVCEventSensorFixes-nk This changeset separates the process that checks for the interrupt key being hit (by waiting on the interrupt semaphore) from the process that periodically gets more events if the UI is not doing so often enough. The advantage of doing this is that we can still remain responsive to interrupts whether the VM signals the semapore or if we detect the interrupt key via processEvent: These changes were suggested by Tim Rowledge. v2: better shutdown for images with prior versions. " Sensor shutDown. Sensor interruptWatcherProcess ifNotNilDo: [ :p | p terminate ]. ! !InputSensor commentStamp: '' prior: 0! An InputSensor is an interface to the user input devices. There is at least one (sub)instance of InputSensor named Sensor in the system. Class variables: ButtonDecodeTable - maps mouse buttons as reported by the VM to ones reported in the events. KeyDecodeTable SmallInteger>> - maps some keys and their modifiers to other keys (used for instance to map Ctrl-X to Alt-X) InterruptSemaphore - signalled by the the VM and/or the event loop upon receiving an interrupt keystroke. InterruptWatcherProcess - waits on the InterruptSemaphore and then responds as appropriate.! InputSensor subclass: #EventSensor instanceVariableNames: 'mouseButtons mousePosition keyboardBuffer interruptKey interruptSemaphore eventQueue inputSemaphore lastEventPoll hadInterrupt hasInputSemaphore ' classVariableNames: 'EventPollFrequency EventTicklerProcess EventPollPeriod ' poolDictionaries: 'EventSensorConstants' category: 'Kernel-Processes'! !EventSensor commentStamp: 'nk 4/13/2004 11:18' 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 inputSemaphore - the semaphore signaled by the VM if asynchronous event notification is supported lastEventPoll - the last millisecondClockValue at which we called fetchMoreEvents hasInputSemaphore - true if my inputSemaphore has actually been signaled at least once. Class variables: EventPollPeriod - the number of milliseconds to wait between polling for more events in the userInterruptHandler. EventTicklerProcess - the process that makes sure that events are polled for often enough (at least every EventPollPeriod milliseconds). 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. ! !InputSensor methodsFor: 'user interrupts' stamp: 'nk 4/12/2004 19:36'! eventTicklerProcess "Answer my event tickler process, if any" ^nil! ! !InputSensor methodsFor: 'user interrupts' stamp: 'gk 2/23/2004 20:51'! userInterruptWatcher "Wait for user interrupts and open a notifier on the active process when one occurs." [true] whileTrue: [ InterruptSemaphore wait. Display deferUpdates: false. SoundService default shutDown. Smalltalk handleUserInterrupt] ! ! !InputSensor methodsFor: 'initialize' stamp: 'nk 4/12/2004 19:45'! shutDown InterruptWatcherProcess ifNotNil: [ InterruptWatcherProcess terminate. InterruptWatcherProcess _ nil ].! ! !EventSensor methodsFor: 'accessing' stamp: 'nk 4/12/2004 19:36'! eventTicklerProcess "Answer my event tickler process, if any" ^EventTicklerProcess! ! !EventSensor methodsFor: 'initialize' stamp: 'nk 4/12/2004 19:21'! initialize "Initialize the receiver" mouseButtons := 0. mousePosition := 0 @ 0. keyboardBuffer := SharedQueue new. self setInterruptKey: (interruptKey ifNil: [$. asciiValue bitOr: 16r0800 ]). "cmd-." interruptSemaphore := (Smalltalk specialObjectsArray at: 31) ifNil: [Semaphore new]. self flushAllButDandDEvents. inputSemaphore := Semaphore new. hasInputSemaphore := false.! ! !EventSensor methodsFor: 'initialize' stamp: 'nk 4/12/2004 20:13'! shutDown super shutDown. EventTicklerProcess ifNotNil: [ EventTicklerProcess terminate. EventTicklerProcess _ nil. ]. inputSemaphore ifNotNil:[Smalltalk unregisterExternalObject: inputSemaphore]. ! ! !EventSensor methodsFor: 'initialize' stamp: 'nk 4/12/2004 19:25'! startUp "Run the I/O process" self shutDown. self initialize. self primSetInputSemaphore: (Smalltalk registerExternalObject: inputSemaphore). super startUp. self installEventTickler. 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 4/12/2004 20:16'! eventTickler "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." | delay | delay := Delay forMilliseconds: self class eventPollPeriod. self lastEventPoll. "ensure not nil." [| delta | [ delay wait. delta := Time millisecondClockValue - lastEventPoll. (delta < 0 or: [delta > self class eventPollPeriod]) ifTrue: ["force check on rollover" self fetchMoreEvents]] on: Error do: [:ex | ]. true ] whileTrue.! ! !EventSensor methodsFor: 'private' stamp: 'nk 4/12/2004 19:25'! installEventTickler "Initialize the interrupt watcher process. Terminate the old process if any." "Sensor installEventTickler" EventTicklerProcess ifNotNil: [EventTicklerProcess terminate]. EventTicklerProcess _ [self eventTickler] newProcess. EventTicklerProcess priority: Processor lowIOPriority. EventTicklerProcess resume. ! ! !EventSensor methodsFor: 'private-I/O' stamp: 'nk 4/12/2004 20:01'! 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 ]. "Remember the last time that I checked for events." lastEventPoll := Time millisecondClockValue. eventBuffer := Array new: 8. [self primGetNextEvent: eventBuffer. type := eventBuffer at: 1. type = EventTypeNone] whileFalse: [self processEvent: eventBuffer]. ! ! !EventSensor methodsFor: 'private-I/O' stamp: 'nk 2/11/2002 12:18'! 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" ^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 class methodsFor: 'class initialization' stamp: 'nk 4/12/2004 18:55'! eventPollPeriod ^EventPollPeriod ifNil: [ EventPollPeriod _ 500 ].! ! !EventSensor class methodsFor: 'class initialization' stamp: 'nk 4/12/2004 18:55'! eventPollPeriod: msec "Set the number of milliseconds between checking for events to msec." EventPollPeriod _ msec max: 10.! ! !ProcessBrowser class methodsFor: 'process control' stamp: 'nk 4/12/2004 19:37'! nameAndRulesFor: aProcess "Answer a nickname and two flags: allow-stop, and allow-debug" ^ [aProcess caseOf: { [] -> [{'no process'. false. false}]. [Smalltalk lowSpaceWatcherProcess] -> [{'the low space watcher'. false. false}]. [WeakArray runningFinalizationProcess] -> [{'the WeakArray finalization process'. false. false}]. [Processor activeProcess] -> [{'the UI process'. false. true}]. [Processor backgroundProcess] -> [{'the idle process'. false. false}]. [Sensor interruptWatcherProcess] -> [{'the user interrupt watcher'. false. false}]. [Sensor eventTicklerProcess] -> [{'the event tickler'. false. false}]. [Project uiProcess] -> [{'the inactive Morphic UI process'. false. false}]. [Smalltalk at: #SoundPlayer ifPresent: [:sp | sp playerProcess]] -> [{'the Sound Player'. false. false}]. [ScheduledControllers ifNotNil: [ScheduledControllers activeControllerProcess]] -> [{'the inactive MVC controller process'. false. true}]. [Smalltalk at: #CPUWatcher ifPresent: [:cw | cw currentWatcherProcess]] -> [{'the CPUWatcher'. false. false}]} otherwise: [(aProcess priority = Processor timingPriority and: [aProcess suspendedContext receiver == Delay]) ifTrue: [{'the timer interrupt watcher'. false. false}] ifFalse: [{aProcess suspendedContext asString. true. true}]]] ifError: [:err :rcvr | {aProcess suspendedContext asString. true. true}]! ! EventSensor class removeSelector: #eventPollFrequency! EventSensor class removeSelector: #eventPollFrequency:! EventSensor removeSelector: #hasWorkingInputSemaphore! EventSensor removeSelector: #inputSemaphore! EventSensor removeSelector: #userInterruptWatcher! InputSensor subclass: #EventSensor instanceVariableNames: 'mouseButtons mousePosition keyboardBuffer interruptKey interruptSemaphore eventQueue inputSemaphore lastEventPoll hasInputSemaphore' classVariableNames: 'EventPollPeriod EventTicklerProcess' poolDictionaries: 'EventSensorConstants' category: 'Kernel-Processes'! !EventSensor reorganize! ('accessing' eventQueue eventTicklerProcess flushAllButDandDEvents flushEvents nextEvent peekButtons peekEvent peekMousePt peekPosition) ('initialize' initialize shutDown startUp) ('mouse' createMouseEvent) ('private' eventTickler flushNonKbdEvents installEventTickler isKbdEvent: lastEventPoll nextEventFromQueue nextEventSynthesized primInterruptSemaphore: primKbdNext primKbdPeek primMouseButtons primMousePt primSetInterruptKey:) ('private-I/O' fetchMoreEvents mapButtons:modifiers: primGetNextEvent: primSetInputSemaphore: processEvent: processKeyboardEvent: processMouseEvent: queueEvent:) ! "Postscript: Ensure that we're using an EventSensor." EventSensor install.!