'From Squeak3.1alpha of 5 February 2001 [latest update: #4361] on 1 October 2001 at 9:23:28 pm'! "Change Set: SensorInMorphic Date: 1 October 2001 Author: Dan Ingalls Prevents dropping keyboard input when using, eg, Sensor keyboardPressed in Morphic by changing a flush of the eventQueue to a selective flush. This allows the InterpreterSimulator (and, eg, ST-72) to run in Morphic on a Mac. "! !EventSensor methodsFor: 'private' stamp: 'di 10/1/2001 20:52'! flushNonKbdEvents eventQueue ifNil: [^ self]. eventQueue flushAllSuchThat: [:buf | (self isKbdEvent: buf) not] ! ! !EventSensor methodsFor: 'private' stamp: 'di 10/1/2001 20:51'! isKbdEvent: buf ^ (buf at: 1) = EventTypeKeyboard and: [(buf at: 4) = EventKeyChar]! ! !EventSensor methodsFor: 'private' stamp: 'di 10/1/2001 20:48'! primMouseButtons inputSemaphore signal. self flushNonKbdEvents. ^ mouseButtons! ! !EventSensor methodsFor: 'private' stamp: 'di 10/1/2001 20:48'! primMousePt inputSemaphore signal. self flushNonKbdEvents. ^ mousePosition! ! !EventSensor methodsFor: 'keyboard' stamp: 'di 10/1/2001 20:53'! primKbdNext "Allows for use of old Sensor protocol to get at the keyboard, as when running kbdTest or the InterpreterSimulator in Morphic" | evtBuf | inputSemaphore signal. keyboardBuffer isEmpty ifFalse:[^ keyboardBuffer next]. eventQueue ifNotNil: [evtBuf _ eventQueue nextOrNilSuchThat: [:buf | self isKbdEvent: buf]. self flushNonKbdEvents]. ^ evtBuf ifNotNil: [evtBuf at: 3] ! ! !EventSensor methodsFor: 'keyboard' stamp: 'di 10/1/2001 21:23'! primKbdPeek "Allows for use of old Sensor protocol to get at the keyboard, as when running kbdTest or the InterpreterSimulator in Morphic" | char | inputSemaphore signal. keyboardBuffer isEmpty ifFalse: [^ keyboardBuffer peek]. char _ nil. eventQueue ifNotNil: [eventQueue nextOrNilSuchThat: "NOTE: must not return out of this block, so loop to end" [:buf | (self isKbdEvent: buf) ifTrue: [char ifNil: [char _ buf at: 3]]. false "NOTE: block value must be false so Queue won't advance"]]. ^ char! ! !SharedQueue methodsFor: 'accessing' stamp: 'di 10/1/2001 18:35'! flushAllSuchThat: aBlock "Remove from the queue all objects that satisfy aBlock." | value newReadPos | accessProtect critical: [ newReadPos _ writePosition. writePosition-1 to: readPosition by: -1 do: [:i | value _ contentsArray at: i. contentsArray at: i put: nil. (aBlock value: value) ifFalse: [newReadPos _ newReadPos - 1. contentsArray at: newReadPos put: value]]. readPosition _ newReadPos. readPosition >= writePosition ifTrue: [readSynch initSignals]. ]. ^value ! ! !SharedQueue methodsFor: 'accessing' stamp: 'di 10/1/2001 20:58'! nextOrNilSuchThat: aBlock "Answer the next object that satisfies aBlock, skipping any intermediate objects. If no object has been sent, answer and leave me intact. NOTA BENE: aBlock MUST NOT contain a non-local return (^)." | value readPos | accessProtect critical: [ value _ nil. readPos _ readPosition. [readPos < writePosition and: [value isNil]] whileTrue: [ value _ contentsArray at: readPos. readPos _ readPos + 1. (aBlock value: value) ifTrue: [ readPosition to: readPos - 1 do: [ :j | contentsArray at: j put: nil. ]. readPosition _ readPos. ] ifFalse: [ value _ nil. ]. ]. readPosition >= writePosition ifTrue: [readSynch initSignals]. ]. ^value "=== q _ SharedQueue new. 1 to: 10 do: [ :i | q nextPut: i]. c _ OrderedCollection new. [ v _ q nextOrNilSuchThat: [ :e | e odd]. v notNil ] whileTrue: [ c add: {v. q size} ]. {c. q} explore ==="! !