The Trunk: Kernel-mt.1028.mcz

Marcel Taeumel uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-mt.1028.mcz

==================== Summary ====================

Name: Kernel-mt.1028
Author: mt
Time: 15 June 2016, 7:55:24.868664 am
UUID: ef9df82a-545e-b44a-9084-8b608be6ce69
Ancestors: Kernel-mt.1027

Extends EventSensor to be prepared for VMs to really send mouse-wheel events.

(Merges several peek* and prim* methods in EventSensor as a clean-up from the former InputSensor days.)

=============== Diff against Kernel-mt.1027 ===============

Item was changed:
  Object subclass: #EventSensor
+ instanceVariableNames: 'mouseButtons mousePosition mouseWheelDelta keyboardBuffer interruptKey interruptSemaphore eventQueue inputSemaphore lastEventPoll hasInputSemaphore'
- instanceVariableNames: 'mouseButtons mousePosition keyboardBuffer interruptKey interruptSemaphore eventQueue inputSemaphore lastEventPoll hasInputSemaphore'
  classVariableNames: 'ButtonDecodeTable EventPollPeriod EventTicklerProcess InterruptSemaphore InterruptWatcherProcess KeyDecodeTable'
  poolDictionaries: 'EventSensorConstants'
  category: 'Kernel-Processes'!
 
  !EventSensor commentStamp: 'dtl 1/30/2016 14:44' prior: 0!
  An EventSensor is an interface to the user input devices.
  There is at least one instance of EventSensor named Sensor in the system.
 
  EventSensor is a replacement for the earlier InputSensor implementation 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 <Integer> - mouse button state as replacement for primMouseButtons
  mousePosition <Point> - mouse position as replacement for primMousePt
  keyboardBuffer <SharedQueue> - keyboard input buffer
  interruptKey <Integer> - currently defined interrupt key
  interruptSemaphore <Semaphore> - the semaphore signaled when the interruptKey is detected
  eventQueue <SharedQueue> - an optional event queue for event driven applications
  inputSemaphore <Semaphore>- the semaphore signaled by the VM if asynchronous event notification is supported
  lastEventPoll <Integer> - the last millisecondClockValue at which we called fetchMoreEvents
  hasInputSemaphore <Boolean> - true if my inputSemaphore has actually been signaled at least once.
 
  Class variables:
  ButtonDecodeTable <ByteArray> - maps mouse buttons as reported by the VM to ones reported in the events.
  KeyDecodeTable <Dictionary<SmallInteger->SmallInteger>> - maps some keys and their modifiers to other keys (used for instance to map Ctrl-X to Alt-X)
  InterruptSemaphore <Semaphore> - signalled by the the VM and/or the event loop upon receiving an interrupt keystroke.
  InterruptWatcherProcess <Process> - waits on the InterruptSemaphore and then responds as appropriate.
  EventPollPeriod <Integer> - the number of milliseconds to wait between polling for more events in the userInterruptHandler.
  EventTicklerProcess <Process> - 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.
  !

Item was changed:
  ----- Method: EventSensor>>anyButtonPressed (in category 'mouse') -----
  anyButtonPressed
  "Answer whether at least one mouse button is currently being pressed."
 
+ ^ self peekButtons anyMask: 7
- ^ self primMouseButtons anyMask: 7
  !

Item was changed:
  ----- Method: EventSensor>>anyModifierKeyPressed (in category 'modifier keys') -----
  anyModifierKeyPressed
  "ignore, however, the shift keys 'cause that's not REALLY a command key"
 
+ ^ self peekButtons anyMask: 16r70 "cmd | opt | ctrl"!
- ^ self primMouseButtons anyMask: 16r70 "cmd | opt | ctrl"!

Item was changed:
  ----- Method: EventSensor>>blueButtonPressed (in category 'mouse') -----
  blueButtonPressed
  "Answer whether only the blue mouse button is being pressed.
  This is the third mouse button or cmd+click on the Mac."
 
+ ^ (self peekButtons bitAnd: 7) = 1
- ^ (self primMouseButtons bitAnd: 7) = 1
  !

Item was changed:
  ----- Method: EventSensor>>commandKeyPressed (in category 'modifier keys') -----
  commandKeyPressed
  "Answer whether the command key on the keyboard is being held down."
 
+ ^ self peekButtons anyMask: 64!
- ^ self primMouseButtons anyMask: 64!

Item was changed:
  ----- Method: EventSensor>>controlKeyPressed (in category 'modifier keys') -----
  controlKeyPressed
  "Answer whether the control key on the keyboard is being held down."
 
+ ^ self peekButtons anyMask: 16!
- ^ self primMouseButtons anyMask: 16!

Item was changed:
  ----- Method: EventSensor>>createMouseEvent (in category 'mouse') -----
  createMouseEvent
  "create and return a new mouse event from the current mouse
  position; this is useful for restarting normal event queue
  processing after manual polling"
 
  | buttons modifiers pos mapped eventBuffer |
  eventBuffer := Array new: 8.
+ buttons := self peekButtons.
+ pos := self peekPosition.
- buttons := self primMouseButtons.
- pos := self primMousePt.
  modifiers := buttons bitShift: -3.
  buttons := buttons bitAnd: 7.
  mapped := self mapButtons: buttons modifiers: modifiers.
  eventBuffer
  at: 1
  put: EventTypeMouse;
  at: 2 put: Time eventMillisecondClock;
  at: 3 put: pos x;
  at: 4 put: pos y;
  at: 5 put: mapped;
  at: 6 put: modifiers.
  ^ eventBuffer!

Item was changed:
  ----- Method: EventSensor>>initialize (in category 'initialize') -----
  initialize
  "Initialize the receiver"
  mouseButtons := 0.
  mousePosition := 0 @ 0.
+ mouseWheelDelta := 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.!

Item was changed:
  ----- Method: EventSensor>>keyboard (in category 'keyboard') -----
  keyboard
  "Answer the next character from the keyboard."
 
  | firstCharacter secondCharactor stream multiCharacter converter |
  firstCharacter := self characterForKeycode: self primKbdNext.
+ secondCharactor := self peekKeyboard.
- secondCharactor := self characterForKeycode: self primKbdPeek.
  secondCharactor isNil
  ifTrue: [^ firstCharacter].
  converter := TextConverter defaultSystemConverter.
  converter isNil
  ifTrue: [^ firstCharacter].
  stream := ReadStream
  on: (String with: firstCharacter with: secondCharactor).
  multiCharacter := converter nextFromStream: stream.
  multiCharacter isOctetCharacter
  ifTrue: [^ multiCharacter].
  self primKbdNext.
  ^ multiCharacter
  !

Item was removed:
- ----- Method: EventSensor>>keyboardPeek (in category 'keyboard') -----
- keyboardPeek
- "Answer the next character in the keyboard buffer without removing it, or nil if it is empty."
-
- ^ self characterForKeycode: self primKbdPeek!

Item was changed:
  ----- Method: EventSensor>>keyboardPressed (in category 'keyboard') -----
  keyboardPressed
  "Answer true if keystrokes are available."
 
+ ^self peekKeyboard notNil!
- ^self primKbdPeek notNil!

Item was changed:
  ----- Method: EventSensor>>leftShiftDown (in category 'modifier keys') -----
  leftShiftDown
  "Answer whether the shift key on the keyboard is being held down. The name of this message is a throwback to the Alto, which had independent left and right shift keys."
 
+ ^ self peekButtons anyMask: 8!
- ^ self primMouseButtons anyMask: 8!

Item was changed:
  ----- Method: EventSensor>>mouseButtons (in category 'mouse') -----
  mouseButtons
  "Answer a number from 0 to 7 that encodes the state of the three mouse buttons in its lowest 3 bits."
 
+ ^ self peekButtons bitAnd: 7
- ^ self primMouseButtons bitAnd: 7
  !

Item was changed:
  ----- Method: EventSensor>>nextEventSynthesized (in category 'private') -----
  nextEventSynthesized
  "Return a synthesized event. This method is called if an event driven client wants to receive events but the primary user interface is not event-driven (e.g., the receiver does not have an event queue but only updates its state). This can, for instance, happen if a Morphic World is run in an MVC window. To simplify the clients work this method will always return all available keyboard events first, and then (repeatedly) the mouse events. Since mouse events come last, the client can assume that after one mouse event has been received there are no more to come. Note that it is impossible for EventSensor to determine if a mouse event has been issued before so the client must be aware of the possible problem of getting repeatedly the same mouse events. See HandMorph>>processEvents for an example on how to deal with this."
  | kbd array buttons pos modifiers mapped |
  "First check for keyboard"
  array := Array new: 8.
  kbd := self primKbdNext.
  kbd ifNotNil:
  ["simulate keyboard event"
  array at: 1 put: EventTypeKeyboard. "evt type"
  array at: 2 put: Time eventMillisecondClock. "time stamp"
  array at: 3 put: (kbd bitAnd: 255). "char code"
  array at: 4 put: EventKeyChar. "key press/release"
  array at: 5 put: (kbd bitShift: -8). "modifier keys"
  ^ array].
 
  "Then check for mouse"
+ pos := self peekPosition.
- pos := self primMousePt.
  buttons := mouseButtons.
  modifiers := buttons bitShift: -3.
  buttons := buttons bitAnd: 7.
  mapped := self mapButtons: buttons modifiers: modifiers.
  array
  at: 1 put: EventTypeMouse;
  at: 2 put: Time eventMillisecondClock;
  at: 3 put: pos x;
  at: 4 put: pos y;
  at: 5 put: mapped;
  at: 6 put: modifiers.
  ^ array
 
  !

Item was changed:
  ----- Method: EventSensor>>peekButtons (in category 'accessing') -----
  peekButtons
  self fetchMoreEvents.
+ self flushNonKbdEvents.
+ ^ mouseButtons!
- ^mouseButtons!

Item was added:
+ ----- Method: EventSensor>>peekKeyboard (in category 'keyboard') -----
+ peekKeyboard
+ "Answer the next character in the keyboard buffer without removing it, or nil if it is empty."
+
+ | char |
+ self fetchMoreEvents.
+ keyboardBuffer isEmpty ifFalse: [^ self characterForKeycode: keyboardBuffer peek].
+ char := nil.
+ self eventQueue ifNotNil: [:queue |
+ queue 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"]].
+ ^ self characterForKeycode: char!

Item was changed:
  ----- Method: EventSensor>>peekPosition (in category 'accessing') -----
  peekPosition
+ self fetchMoreEvents.
+ "self flushNonKbdEvents. -- mt: Should not be necessary here."
+ ^ mousePosition!
- ^ self primMousePt!

Item was added:
+ ----- Method: EventSensor>>peekWheelDelta (in category 'accessing') -----
+ peekWheelDelta
+ self fetchMoreEvents.
+ ^ mouseWheelDelta!

Item was changed:
  ----- Method: EventSensor>>primKbdNext (in category 'private') -----
  primKbdNext
  "Allows for use of old Sensor protocol to get at the keyboard,
  as when running kbdTest or the InterpreterSimulator in Morphic"
  | evtBuf |
+
+ self flag: #refactor. "mt: Suspiciously similar to #peekKeyboardEvent"
  self fetchMoreEvents.
  keyboardBuffer isEmpty ifFalse:[^ keyboardBuffer next].
  self eventQueue ifNotNil: [:queue |
  evtBuf := queue nextOrNilSuchThat: [:buf | self isKbdEvent: buf].
  self flushNonKbdEvents].
  ^ evtBuf ifNotNil: [evtBuf at: 3]
  !

Item was removed:
- ----- Method: EventSensor>>primKbdPeek (in category 'private') -----
- primKbdPeek
- "Allows for use of old Sensor protocol to get at the keyboard,
- as when running kbdTest or the InterpreterSimulator in Morphic"
- | char |
- self fetchMoreEvents.
- keyboardBuffer isEmpty ifFalse: [^ keyboardBuffer peek].
- char := nil.
- self eventQueue ifNotNil: [:queue |
- queue 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!

Item was removed:
- ----- Method: EventSensor>>primMouseButtons (in category 'private') -----
- primMouseButtons
- self fetchMoreEvents.
- self flushNonKbdEvents.
- ^ mouseButtons!

Item was removed:
- ----- Method: EventSensor>>primMousePt (in category 'private') -----
- primMousePt
- self fetchMoreEvents.
- "self flushNonKbdEvents. -- mt: Should not be necessary here."
- ^ mousePosition!

Item was changed:
  ----- Method: EventSensor>>processEvent: (in category 'private-I/O') -----
  processEvent: evt
  "Process a single event. This method is run at high priority."
  | type buttons window |
  type := evt at: 1.
 
  "Only process main window events, forward others to host window proxies"
  window := evt at: 8.
  (window isNil or: [window isZero]) ifTrue:
  [window := 1.
  evt at: 8 put: window].
  window = 1 ifFalse: [
  ^Smalltalk at: #HostWindowProxy ifPresent: [:w | w processEvent: evt]].
 
+ "Tackle mouse events and mouse wheel events first"
+ (type = EventTypeMouse or: [type = EventTypeMouseWheel])
- "Tackle mouse events first"
- type = EventTypeMouse
  ifTrue: [buttons := (ButtonDecodeTable at: (evt at: 5) + 1).
  evt at: 5 put: (Smalltalk platformName = 'Mac OS'
  ifTrue: [ buttons ]
  ifFalse: [ self mapButtons: buttons modifiers: (evt at: 6) ]).
  self queueEvent: evt.
+ type = EventTypeMouse ifTrue: [self processMouseEvent: evt].
+ type = EventTypeMouseWheel ifTrue: [self processMouseWheelEvent: evt].
- self processMouseEvent: evt .
  ^self].
 
-
  "Store the event in the queue if there's any"
  type = EventTypeKeyboard
  ifTrue: [ "Check if the event is a user interrupt"
  ((evt at: 4) = 0
  and: [((evt at: 3)
  bitOr: (((evt at: 5)
  bitAnd: 8)
  bitShift: 8))
  = interruptKey])
  ifTrue: ["interrupt key is meta - not reported as event"
  ^ interruptSemaphore signal].
  "Else swap ctrl/alt keys if neeeded.
  Look at the Unicode char first, then ascii."
  KeyDecodeTable
  at: {evt at: 6. evt at: 5}
  ifPresent: [:a | evt at: 6 put: a first;
  at: 5 put: a second].
  KeyDecodeTable
  at: {evt at: 3. evt at: 5}
  ifPresent: [:a | evt at: 3 put: a first;
  at: 5 put: a second].
  self queueEvent: evt.
  self processKeyboardEvent: evt .
  ^self ].
 
  "Handle all events other than Keyborad or Mouse."
  self queueEvent: evt.
  !

Item was added:
+ ----- Method: EventSensor>>processMouseWheelEvent: (in category 'private-I/O') -----
+ processMouseWheelEvent: evt
+ "process a mouse wheel event, updating EventSensor state"
+
+ | modifiers buttons mapped |
+ mouseWheelDelta := (evt at: 3) @ (evt at: 4).
+ buttons := evt at: 5.
+ modifiers := evt at: 6.
+ mapped := self mapButtons: buttons modifiers: modifiers.
+ mouseButtons := mapped bitOr: (modifiers bitShift: 3).!

Item was changed:
  ----- Method: EventSensor>>rawMacOptionKeyPressed (in category 'modifier keys') -----
  rawMacOptionKeyPressed
  "Answer whether the option key on the Macintosh keyboard is being held down. Macintosh specific.  Clients are discouraged from calling this directly, since it circumvents bert's attempt to eradicate option-key checks"
 
+ ^ self peekButtons anyMask: 32!
- ^ self primMouseButtons anyMask: 32!

Item was changed:
  ----- Method: EventSensor>>redButtonPressed (in category 'mouse') -----
  redButtonPressed
  "Answer true if only the red mouse button is being pressed.
  This is the first mouse button, usually the left one."
 
+ ^ (self peekButtons bitAnd: 7) = 4
- ^ (self primMouseButtons bitAnd: 7) = 4
  !

Item was changed:
  ----- Method: EventSensor>>shiftPressed (in category 'modifier keys') -----
  shiftPressed
  "Answer whether the shift key on the keyboard is being held down."
 
+ ^ self peekButtons anyMask: 8
- ^ self primMouseButtons anyMask: 8
  !

Item was changed:
  ----- Method: EventSensor>>yellowButtonPressed (in category 'mouse') -----
  yellowButtonPressed
  "Answer whether only the yellow mouse button is being pressed.
  This is the second mouse button or option+click on the Mac."
 
+ ^ (self peekButtons bitAnd: 7) = 2
- ^ (self primMouseButtons bitAnd: 7) = 2
  !

Item was changed:
  SharedPool subclass: #EventSensorConstants
  instanceVariableNames: ''
+ classVariableNames: 'BlueButtonBit CommandKeyBit CtrlKeyBit EventKeyChar EventKeyDown EventKeyUp EventTouchCancelled EventTouchDown EventTouchMoved EventTouchStationary EventTouchUp EventTypeComplex EventTypeDragDropFiles EventTypeKeyboard EventTypeMenu EventTypeMouse EventTypeMouseWheel EventTypeNone EventTypeWindow OptionKeyBit RedButtonBit ShiftKeyBit TouchPhaseBegan TouchPhaseCancelled TouchPhaseEnded TouchPhaseMoved TouchPhaseStationary WindowEventActivated WindowEventClose WindowEventIconise WindowEventMetricChange WindowEventPaint WindowEventStinks YellowButtonBit'
- classVariableNames: 'BlueButtonBit CommandKeyBit CtrlKeyBit EventKeyChar EventKeyDown EventKeyUp EventTouchCancelled EventTouchDown EventTouchMoved EventTouchStationary EventTouchUp EventTypeComplex EventTypeDragDropFiles EventTypeKeyboard EventTypeMenu EventTypeMouse EventTypeNone EventTypeWindow OptionKeyBit RedButtonBit ShiftKeyBit TouchPhaseBegan TouchPhaseCancelled TouchPhaseEnded TouchPhaseMoved TouchPhaseStationary WindowEventActivated WindowEventClose WindowEventIconise WindowEventMetricChange WindowEventPaint WindowEventStinks YellowButtonBit'
  poolDictionaries: ''
  category: 'Kernel-Processes'!

Item was changed:
  ----- Method: EventSensorConstants class>>initialize (in category 'pool initialization') -----
  initialize
  "EventSensorConstants initialize"
  RedButtonBit := 4.
  BlueButtonBit := 2.
  YellowButtonBit := 1.
 
  ShiftKeyBit := 1.
  CtrlKeyBit := 2.
  OptionKeyBit := 4.
  CommandKeyBit := 8.
 
  "Types of events"
  EventTypeNone := 0.
  EventTypeMouse := 1.
  EventTypeKeyboard := 2.
  EventTypeDragDropFiles := 3.
  EventTypeMenu := 4.
  EventTypeWindow := 5.
  EventTypeComplex := 6.
+ EventTypeMouseWheel := 7.
 
  "Press codes for keyboard events"
  EventKeyChar := 0.
  EventKeyDown := 1.
  EventKeyUp := 2.
 
  "Host window events"
  WindowEventMetricChange := 1.
  WindowEventClose := 2.
  WindowEventIconise := 3.
  WindowEventActivated := 4.
  WindowEventPaint := 5.
  WindowEventStinks := 6.
 
  "types for touch events"
  EventTouchDown := 1.
  EventTouchUp := 2.
  EventTouchMoved := 3.
  EventTouchStationary := 4.
  EventTouchCancelled := 5.
 
  "iOS touch phase constants"
  TouchPhaseBegan := 0.
  TouchPhaseMoved := 1.
  TouchPhaseStationary := 2.
  TouchPhaseEnded := 3.
  TouchPhaseCancelled := 4.
  !