[squeak-dev] The Inbox: Kernel-dtl.981.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Jan 30 16:11:14 UTC 2016


David T. Lewis uploaded a new version of Kernel to project The Inbox:
http://source.squeak.org/inbox/Kernel-dtl.981.mcz

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

Name: Kernel-dtl.981
Author: dtl
Time: 30 January 2016, 11:08:34.12478 am
UUID: f28a2de4-862d-4499-90cd-5eb04e0649d3
Ancestors: Kernel-eem.980

InputSensor removal step 1.

Move instance methods to EventSensor, eliminate super calls, resolve primitive fallbacks, recategorize. Preserve original method stamps where possible.

Class variables and system startup/shutdown to be addressed next.

=============== Diff against Kernel-eem.980 ===============

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

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

Item was added:
+ ----- 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 primMouseButtons bitAnd: 7) = 1
+ !

Item was added:
+ ----- Method: EventSensor>>characterForKeycode: (in category 'keyboard') -----
+ characterForKeycode: keycode
+ 	"Map the given keycode to a Smalltalk character object. Encoding:
+ 		A keycode is 12 bits:   <4 modifer bits><8 bit ISO character>
+ 		Modifier bits are:       <command><option><control><shift>"
+ 
+ 	"NOTE: the command and option keys are specific to the Macintosh and may not have equivalents on other platforms."
+ 
+ 	keycode = nil ifTrue: [ ^nil ].
+ 	keycode class = Character ifTrue: [ ^keycode ].  "to smooth the transition!!"
+ 	^ Character value: (keycode bitAnd: 16rFF)!

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

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

Item was added:
+ ----- Method: EventSensor>>cursorPoint (in category 'cursor') -----
+ cursorPoint
+ 	"Answer a Point indicating the cursor location."
+ 
+ 	^self mousePoint!

Item was added:
+ ----- Method: EventSensor>>cursorPoint: (in category 'cursor') -----
+ cursorPoint: aPoint 
+ 	"Set aPoint to be the current cursor location."
+ 
+ 	^self primCursorLocPut: aPoint!

Item was changed:
  ----- Method: EventSensor>>eventQueue (in category 'accessing') -----
  eventQueue
+ 	^nil!
- 	"Return the current event queue"
- 	^eventQueue!

Item was added:
+ ----- Method: EventSensor>>eventQueue: (in category 'accessing') -----
+ eventQueue: aSharedQueue
+ !

Item was added:
+ ----- Method: EventSensor>>flushKeyboard (in category 'keyboard') -----
+ flushKeyboard
+ 	"Remove all characters from the keyboard buffer."
+ 
+ 	[self keyboardPressed]
+ 		whileTrue: [self keyboard]!

Item was added:
+ ----- Method: EventSensor>>hasTablet (in category 'tablet') -----
+ hasTablet
+ 	"Answer true if there is a pen tablet available on this computer."
+ 
+ 	^ (self primTabletGetParameters: 1) notNil
+ !

Item was added:
+ ----- Method: EventSensor>>joystickButtons: (in category 'joystick') -----
+ joystickButtons: index
+ 
+ 	^ ((self primReadJoystick: index) bitShift: -22) bitAnd: 16r71F
+ 	!

Item was added:
+ ----- Method: EventSensor>>joystickOn: (in category 'joystick') -----
+ joystickOn: index
+ 
+ 	^ (((self primReadJoystick: index) bitShift: -27) bitAnd: 1) ~= 0
+ 	!

Item was added:
+ ----- Method: EventSensor>>joystickXY: (in category 'joystick') -----
+ joystickXY: index
+ 
+ 	| inputWord x y |
+ 	inputWord := self primReadJoystick: index.
+ 	x := (inputWord bitAnd: 16r7FF) - 16r400.
+ 	y := ((inputWord bitShift: -11) bitAnd: 16r7FF) - 16r400.
+ 	^ x at y
+ 	!

Item was added:
+ ----- 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 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 added:
+ ----- 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 added:
+ ----- Method: EventSensor>>keyboardPressed (in category 'keyboard') -----
+ keyboardPressed
+ 	"Answer true if keystrokes are available."
+ 
+ 	^self primKbdPeek notNil!

Item was added:
+ ----- 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 primMouseButtons anyMask: 8!

Item was added:
+ ----- 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 primMouseButtons bitAnd: 7
+ !

Item was added:
+ ----- Method: EventSensor>>mousePoint (in category 'mouse') -----
+ mousePoint
+ 	"Answer a Point indicating the coordinates of the current mouse location."
+ 
+ 	^self primMousePt!

Item was added:
+ ----- Method: EventSensor>>noButtonPressed (in category 'mouse') -----
+ noButtonPressed
+ 	"Answer whether any mouse button is not being pressed."
+ 
+ 	^self anyButtonPressed not
+ !

Item was added:
+ ----- Method: EventSensor>>oldPrimInterruptSemaphore: (in category 'primitives-fallback') -----
+ oldPrimInterruptSemaphore: aSemaphore 
+ 	"Primitive. Install the argument as the semaphore to be signalled whenever the user presses the interrupt key. The semaphore will be signaled once each time the interrupt key is pressed."
+ 
+ 	<primitive: 134>
+ 	^self primitiveFailed
+ "Note: This primitive is obsolete with the new event driven architecture in which EventSensor can handle the interrupts itself. However, for supporting older images running on newer VMs the primitive must still be implemented."!

Item was added:
+ ----- Method: EventSensor>>oldPrimKbdNext (in category 'primitives-fallback') -----
+ oldPrimKbdNext
+ 	<primitive: 108>
+ 	^ nil!

Item was added:
+ ----- Method: EventSensor>>oldPrimMouseButtons (in category 'primitives-fallback') -----
+ oldPrimMouseButtons
+ 	<primitive: 107>
+ 	^ 0!

Item was added:
+ ----- Method: EventSensor>>oldPrimMousePt (in category 'primitives-fallback') -----
+ oldPrimMousePt
+ 	"Primitive. Poll the mouse to find out its position. Return a Point. Fail if
+ 	event-driven tracking is used instead of polling. Optional. See Object
+ 	documentation whatIsAPrimitive."
+ 
+ 	<primitive: 90>
+ 	^ 0 at 0!

Item was added:
+ ----- Method: EventSensor>>oldPrimSetInterruptKey: (in category 'primitives-fallback') -----
+ oldPrimSetInterruptKey: anInteger
+ 	"Primitive. Register the given keycode as the user interrupt key. The low byte of the keycode is the ISO character and its next four bits are the Smalltalk modifer bits <cmd><opt><ctrl><shift>."
+ 
+ 	<primitive: 133>
+ 	^self primitiveFailed
+ "Note: This primitive is obsolete with the new event driven architecture in which EventSensor can handle the interrupts itself. However, for supporting older images running on newer VMs the primitive must still be implemented."!

Item was added:
+ ----- Method: EventSensor>>primCursorLocPut: (in category 'primitives-cursor') -----
+ primCursorLocPut: aPoint
+ 	"If the primitive fails, try again with a rounded point."
+ 
+ 	<primitive: 91>
+ 	^ self primCursorLocPutAgain: aPoint rounded!

Item was added:
+ ----- Method: EventSensor>>primCursorLocPutAgain: (in category 'primitives-cursor') -----
+ primCursorLocPutAgain: aPoint
+ 	"Do nothing if primitive is not implemented."
+ 
+ 	<primitive: 91>
+ 	^ self!

Item was changed:
  ----- Method: EventSensor>>primGetNextEvent: (in category 'private-I/O') -----
  primGetNextEvent: array
  	"Store the next OS event available into the provided array.
  	Essential. If the VM is not event driven the ST code will fall
  	back to the old-style mechanism and use the state based
  	primitives instead."
  	| kbd buttons modifiers pos mapped |
  	<primitive: 94>
  	"Simulate the events"
  	array at: 1 put: EventTypeNone. "assume no more events"
  
  	"First check for keyboard"
+ 	kbd := self oldPrimKbdNext.
- 	kbd := super primKbdNext.
  	kbd = nil ifFalse:[
  		"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"
  		^self].
  
  	"Then check for mouse"
+ 	buttons := self oldPrimMouseButtons.
+ 	pos := self oldPrimMousePt.
- 	buttons := super primMouseButtons.
- 	pos := super primMousePt.
  	modifiers := buttons bitShift: -3.
  	buttons := buttons bitAnd: 7.
  	mapped := self mapButtons: buttons modifiers: modifiers.
  	(pos = mousePosition and:[(mapped bitOr: (modifiers bitShift: 3)) = mouseButtons])
  		ifTrue:[^self].
  	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.
  !

Item was changed:
  ----- Method: EventSensor>>primInterruptSemaphore: (in category 'private') -----
  primInterruptSemaphore: aSemaphore 
  	"Primitive. Install the argument as the semaphore to be signalled whenever the user presses the interrupt key. The semaphore will be signaled once each time the interrupt key is pressed."
  	interruptSemaphore := aSemaphore.
  	"backward compatibility: use the old primitive which is obsolete now"
+ 	self oldPrimInterruptSemaphore: aSemaphore!
- 	super primInterruptSemaphore: aSemaphore!

Item was added:
+ ----- Method: EventSensor>>primReadJoystick: (in category 'primitives-tablet') -----
+ primReadJoystick: index
+ 	"Return the joystick input word for the joystick with the given index in the range [1..16]. Returns zero if the index does not correspond to a currently installed joystick."
+ 
+ 	<primitive: 'primitiveReadJoystick' module: 'JoystickTabletPlugin'>
+ 	^ 0
+ 
+ 	!

Item was changed:
  ----- Method: EventSensor>>primSetInterruptKey: (in category 'private') -----
  primSetInterruptKey: anInteger
  	"Primitive. Register the given keycode as the user interrupt key. The low byte of the keycode is the ISO character and its next four bits are the Smalltalk modifer bits <cmd><opt><ctrl><shift>."
  	interruptKey := anInteger.
  	"backward compatibility: use the old primitive which is obsolete now"
+ 	self oldPrimSetInterruptKey: anInteger!
- 	super primSetInterruptKey: anInteger!

Item was added:
+ ----- Method: EventSensor>>primTabletGetParameters: (in category 'primitives-tablet') -----
+ primTabletGetParameters: cursorIndex
+ 	"Answer the pen tablet parameters. For parameters that differ from cursor to cursor, answer those associated with the cursor having the given index. Answer nil if there is no pen tablet. The parameters are:
+ 	1. tablet width, in tablet units
+ 	2. tablet height, in tablet units
+ 	3. number of tablet units per inch
+ 	4. number of cursors (pens, pucks, etc; some tablets have more than one)
+ 	5. this cursor index
+ 	6. and 7. x scale and x offset for scaling tablet coordintes (e.g., to fit the screen)
+ 	8. and 9. y scale and y offset for scaling tablet coordintes  (e.g., to fit the screen)
+ 	10. number of pressure levels
+ 	11. presure threshold needed close pen tip switch 
+ 	12. number of pen tilt angles"
+ 
+ 	<primitive: 'primitiveGetTabletParameters' module: 'JoystickTabletPlugin'>
+ 	^ nil
+ !

Item was added:
+ ----- Method: EventSensor>>primTabletRead: (in category 'primitives-tablet') -----
+ primTabletRead: cursorIndex
+ 	"Answer the pen tablet data for the cursor having the given index. Answer nil if there is no pen tablet. The data is:
+ 	1. index of the cursor to which this data applies
+ 	2. timestamp of the last state chance for this cursor
+ 	3., 4., and 5. x, y, and z coordinates of the cursor (z is typically 0)
+ 	6. and 7. xTilt and yTilt of the cursor; (signed)
+ 	8. type of cursor (0 = unknown, 1 = pen, 2 = puck, 3 = eraser)
+ 	9. cursor buttons
+ 	10. cursor pressure, downward
+ 	11. cursor pressure, tangential
+ 	12. flags"
+ 
+ 	<primitive: 'primitiveReadTablet' module: 'JoystickTabletPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- 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 primMouseButtons anyMask: 32!

Item was added:
+ ----- 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 primMouseButtons bitAnd: 7) = 4
+ !

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

Item was added:
+ ----- Method: EventSensor>>tabletExtent (in category 'tablet') -----
+ tabletExtent
+ 	"Answer the full tablet extent in tablet coordinates."
+ 
+ 	| params |
+ 	params := self primTabletGetParameters: 1.
+ 	params ifNil: [^ self error: 'no tablet available'].
+ 	^ (params at: 1)@(params at: 2)
+ !

Item was added:
+ ----- Method: EventSensor>>tabletPoint (in category 'tablet') -----
+ tabletPoint
+ 	"Answer the current position of the first tablet pointing device (pen, puck, or eraser) in tablet coordinates."
+ 
+ 	| data |
+ 	data := self primTabletRead: 1.  "state of first/primary pen"
+ 	^ (data at: 3) @ (data at: 4)
+ !

Item was added:
+ ----- Method: EventSensor>>tabletPressure (in category 'tablet') -----
+ tabletPressure
+ 	"Answer the current pressure of the first tablet pointing device (pen, puck, or eraser), a number between 0.0 (no pressure) and 1.0 (max pressure)"
+ 
+ 	| params data |
+ 	params := self primTabletGetParameters: 1.
+ 	params ifNil: [^ self].
+ 	data := self primTabletRead: 1.  "state of first/primary pen"
+ 	^ (data at: 10) asFloat / ((params at: 10) - 1)
+ !

Item was added:
+ ----- Method: EventSensor>>tabletTimestamp (in category 'tablet') -----
+ tabletTimestamp
+ 	"Answer the time (in tablet clock ticks) at which the tablet's primary pen last changed state. This can be used in polling loops; if this timestamp hasn't changed, then the pen state hasn't changed either."
+ 
+ 	| data |
+ 	data := self primTabletRead: 1.  "state of first/primary pen"
+ 	^ data at: 2
+ !

Item was added:
+ ----- Method: EventSensor>>waitButton (in category 'mouse') -----
+ waitButton
+ 	"Wait for the user to press any mouse button and then answer with the 
+ 	current location of the cursor."
+ 
+ 	| delay |
+ 	delay := Delay forMilliseconds: 50.
+ 	[self anyButtonPressed] whileFalse: [ delay wait ].
+ 	^self cursorPoint
+ !

Item was added:
+ ----- Method: EventSensor>>waitButtonOrKeyboard (in category 'mouse') -----
+ waitButtonOrKeyboard
+ 	"Wait for the user to press either any mouse button or any key. 
+ 	Answer the current cursor location or nil if a keypress occured."
+ 
+ 	| delay |
+ 	delay := Delay forMilliseconds: 50.
+ 	[self anyButtonPressed]
+ 		whileFalse: [delay wait.
+ 			self keyboardPressed
+ 				ifTrue: [^ nil]].
+ 	^ self cursorPoint
+ !

Item was added:
+ ----- Method: EventSensor>>waitClickButton (in category 'mouse') -----
+ waitClickButton
+ 	"Wait for the user to click (press and then release) any mouse button and 
+ 	then answer with the current location of the cursor."
+ 
+ 	self waitButton.
+ 	^self waitNoButton!

Item was added:
+ ----- Method: EventSensor>>waitNoButton (in category 'mouse') -----
+ waitNoButton
+ 	"Wait for the user to release any mouse button and then answer the current location of the cursor."
+ 
+ 	| delay |
+ 	delay := Delay forMilliseconds: 50.
+ 	[self anyButtonPressed] whileTrue: [ delay wait].
+ 	^self cursorPoint
+ !

Item was added:
+ ----- 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 primMouseButtons bitAnd: 7) = 2
+ !

Item was removed:
- ----- Method: InputSensor class>>duplicateAllControlAndAltKeysChanged (in category 'preference change notification') -----
- duplicateAllControlAndAltKeysChanged
- 	"The Preference for duplicateAllControlAndAltKeys has changed; reset the other two."
- 	"At some point the various exclusive CtrlAlt-key prefs should become a radio button set, then these methods wouldn't be needed."
- 	(Preferences
- 		valueOfFlag: #swapControlAndAltKeys
- 		ifAbsent: [false]) ifTrue: [
- 			self inform: 'Resetting swapControlAndAltKeys preference'.
- 			(Preferences preferenceAt: #swapControlAndAltKeys) rawValue: false.
- 		].
- 	(Preferences
- 		valueOfFlag: #duplicateControlAndAltKeys
- 		ifAbsent: [false]) ifTrue: [
- 			self inform: 'Resetting duplicateControlAndAltKeys preference'.
- 			(Preferences preferenceAt: #duplicateControlAndAltKeys) rawValue: false.
- 		].
- 	self installKeyDecodeTable.
- !

Item was removed:
- ----- Method: InputSensor class>>duplicateControlAndAltKeysChanged (in category 'preference change notification') -----
- duplicateControlAndAltKeysChanged
- 	"The Preference for duplicateControlAndAltKeys has changed; reset the other two."
- 	(Preferences
- 		valueOfFlag: #swapControlAndAltKeys
- 		ifAbsent: [false]) ifTrue: [
- 			self inform: 'Resetting swapControlAndAltKeys preference'.
- 			(Preferences preferenceAt: #swapControlAndAltKeys) rawValue: false.
- 		].
- 	(Preferences
- 		valueOfFlag: #duplicateAllControlAndAltKeys
- 		ifAbsent: [false]) ifTrue: [
- 			self inform: 'Resetting duplicateAllControlAndAltKeys preference'.
- 			(Preferences preferenceAt: #duplicateAllControlAndAltKeys) rawValue: false.
- 		].
- 	self installKeyDecodeTable.
- !

Item was removed:
- ----- Method: InputSensor class>>swapControlAndAltKeysChanged (in category 'preference change notification') -----
- swapControlAndAltKeysChanged
- 	"The Preference for swapControlAndAltKeys has changed; reset the other two."
- 	(Preferences
- 		valueOfFlag: #duplicateControlAndAltKeys
- 		ifAbsent: [false]) ifTrue: [
- 			self inform: 'Resetting duplicateControlAndAltKeys preference'.
- 			(Preferences preferenceAt: #duplicateControlAndAltKeys) rawValue: false.
- 		].
- 	(Preferences
- 		valueOfFlag: #duplicateAllControlAndAltKeys
- 		ifAbsent: [false]) ifTrue: [
- 			self inform: 'Resetting duplicateAllControlAndAltKeys preference'.
- 			(Preferences preferenceAt: #duplicateAllControlAndAltKeys) rawValue: false.
- 		].
- 	self installKeyDecodeTable.
- !

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

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

Item was removed:
- ----- Method: InputSensor>>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 primMouseButtons bitAnd: 7) = 1
- !

Item was removed:
- ----- Method: InputSensor>>buttons (in category 'buttons') -----
- buttons
- 	"Answer the result of primMouseButtons, but swap the mouse  
- 	buttons if Preferences swapMouseButtons is set."
- 	^ ButtonDecodeTable at: self primMouseButtons + 1!

Item was removed:
- ----- Method: InputSensor>>characterForKeycode: (in category 'private') -----
- characterForKeycode: keycode
- 	"Map the given keycode to a Smalltalk character object. Encoding:
- 		A keycode is 12 bits:   <4 modifer bits><8 bit ISO character>
- 		Modifier bits are:       <command><option><control><shift>"
- 
- 	"NOTE: the command and option keys are specific to the Macintosh and may not have equivalents on other platforms."
- 
- 	keycode = nil ifTrue: [ ^nil ].
- 	keycode class = Character ifTrue: [ ^keycode ].  "to smooth the transition!!"
- 	^ Character value: (keycode bitAnd: 16rFF)!

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

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

Item was removed:
- ----- Method: InputSensor>>cursorPoint (in category 'cursor') -----
- cursorPoint
- 	"Answer a Point indicating the cursor location."
- 
- 	^self mousePoint!

Item was removed:
- ----- Method: InputSensor>>cursorPoint: (in category 'cursor') -----
- cursorPoint: aPoint 
- 	"Set aPoint to be the current cursor location."
- 
- 	^self primCursorLocPut: aPoint!

Item was removed:
- ----- Method: InputSensor>>eventQueue (in category 'accessing') -----
- eventQueue
- 	^nil!

Item was removed:
- ----- Method: InputSensor>>eventQueue: (in category 'accessing') -----
- eventQueue: aSharedQueue
- !

Item was removed:
- ----- Method: InputSensor>>eventTicklerProcess (in category 'user interrupts') -----
- eventTicklerProcess
- 	"Answer my event tickler process, if any"
- 	^nil!

Item was removed:
- ----- Method: InputSensor>>flushAllButDandDEvents (in category 'accessing') -----
- flushAllButDandDEvents!

Item was removed:
- ----- Method: InputSensor>>flushKeyboard (in category 'keyboard') -----
- flushKeyboard
- 	"Remove all characters from the keyboard buffer."
- 
- 	[self keyboardPressed]
- 		whileTrue: [self keyboard]!

Item was removed:
- ----- Method: InputSensor>>hasTablet (in category 'tablet') -----
- hasTablet
- 	"Answer true if there is a pen tablet available on this computer."
- 
- 	^ (self primTabletGetParameters: 1) notNil
- !

Item was removed:
- ----- Method: InputSensor>>inputProcess (in category 'user interrupts') -----
- inputProcess
- 	"For non-event image compatibility"
- 	^ nil!

Item was removed:
- ----- Method: InputSensor>>joystickButtons: (in category 'joystick') -----
- joystickButtons: index
- 
- 	^ ((self primReadJoystick: index) bitShift: -22) bitAnd: 16r71F
- 	!

Item was removed:
- ----- Method: InputSensor>>joystickOn: (in category 'joystick') -----
- joystickOn: index
- 
- 	^ (((self primReadJoystick: index) bitShift: -27) bitAnd: 1) ~= 0
- 	!

Item was removed:
- ----- Method: InputSensor>>joystickXY: (in category 'joystick') -----
- joystickXY: index
- 
- 	| inputWord x y |
- 	inputWord := self primReadJoystick: index.
- 	x := (inputWord bitAnd: 16r7FF) - 16r400.
- 	y := ((inputWord bitShift: -11) bitAnd: 16r7FF) - 16r400.
- 	^ x at y
- 	!

Item was removed:
- ----- Method: InputSensor>>kbdTest (in category 'keyboard') -----
- kbdTest    "Sensor kbdTest"
- 	"This test routine will print the unmodified character, its keycode,
- 	and the OR of all its modifier bits, until the character x is typed"
- 	| char |
- 	char := nil.
- 	[char = $x] whileFalse: 
- 		[[self keyboardPressed] whileFalse: [].
- 		char := self characterForKeycode: self keyboard.
- 		(String streamContents: 
- 			[:s | s nextPut: char; space; print: char asciiValue;
- 					space; print: self primMouseButtons; nextPutAll: '     '])
- 			displayAt: 10 at 10]!

Item was removed:
- ----- Method: InputSensor>>keyboard (in category 'keyboard') -----
- keyboard
- 	"Answer the next character from the keyboard."
- 
- 	| firstCharacter secondCharactor stream multiCharacter converter |
- 	firstCharacter := self characterForKeycode: self primKbdNext.
- 	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: InputSensor>>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 removed:
- ----- Method: InputSensor>>keyboardPressed (in category 'keyboard') -----
- keyboardPressed
- 	"Answer true if keystrokes are available."
- 
- 	^self primKbdPeek notNil!

Item was removed:
- ----- Method: InputSensor>>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 primMouseButtons anyMask: 8!

Item was removed:
- ----- Method: InputSensor>>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 primMouseButtons bitAnd: 7
- !

Item was removed:
- ----- Method: InputSensor>>mousePoint (in category 'mouse') -----
- mousePoint
- 	"Answer a Point indicating the coordinates of the current mouse location."
- 
- 	^self primMousePt!

Item was removed:
- ----- Method: InputSensor>>noButtonPressed (in category 'mouse') -----
- noButtonPressed
- 	"Answer whether any mouse button is not being pressed."
- 
- 	^self anyButtonPressed not
- !

Item was removed:
- ----- Method: InputSensor>>peekButtons (in category 'mouse') -----
- peekButtons
- 	^self primMouseButtons!

Item was removed:
- ----- Method: InputSensor>>peekMousePt (in category 'mouse') -----
- peekMousePt
- 	^self primMousePt!

Item was removed:
- ----- Method: InputSensor>>peekPosition (in category 'cursor') -----
- peekPosition
- 	^self cursorPoint!

Item was removed:
- ----- Method: InputSensor>>primCursorLocPut: (in category 'private') -----
- primCursorLocPut: aPoint
- 	"If the primitive fails, try again with a rounded point."
- 
- 	<primitive: 91>
- 	^ self primCursorLocPutAgain: aPoint rounded!

Item was removed:
- ----- Method: InputSensor>>primCursorLocPutAgain: (in category 'private') -----
- primCursorLocPutAgain: aPoint
- 	"Do nothing if primitive is not implemented."
- 
- 	<primitive: 91>
- 	^ self!

Item was removed:
- ----- Method: InputSensor>>primInterruptSemaphore: (in category 'private') -----
- primInterruptSemaphore: aSemaphore 
- 	"Primitive. Install the argument as the semaphore to be signalled whenever the user presses the interrupt key. The semaphore will be signaled once each time the interrupt key is pressed."
- 
- 	<primitive: 134>
- 	^self primitiveFailed
- "Note: This primitive is obsolete with the new event driven architecture in which EventSensor can handle the interrupts itself. However, for supporting older images running on newer VMs the primitive must still be implemented."!

Item was removed:
- ----- Method: InputSensor>>primKbdNext (in category 'private') -----
- primKbdNext
- 	<primitive: 108>
- 	^ nil!

Item was removed:
- ----- Method: InputSensor>>primKbdPeek (in category 'private') -----
- primKbdPeek
- 	<primitive: 109>
- 	^ nil!

Item was removed:
- ----- Method: InputSensor>>primMouseButtons (in category 'private') -----
- primMouseButtons
- 	<primitive: 107>
- 	^ 0!

Item was removed:
- ----- Method: InputSensor>>primMousePt (in category 'private') -----
- primMousePt
- 	"Primitive. Poll the mouse to find out its position. Return a Point. Fail if
- 	event-driven tracking is used instead of polling. Optional. See Object
- 	documentation whatIsAPrimitive."
- 
- 	<primitive: 90>
- 	^ 0 at 0!

Item was removed:
- ----- Method: InputSensor>>primReadJoystick: (in category 'private') -----
- primReadJoystick: index
- 	"Return the joystick input word for the joystick with the given index in the range [1..16]. Returns zero if the index does not correspond to a currently installed joystick."
- 
- 	<primitive: 'primitiveReadJoystick' module: 'JoystickTabletPlugin'>
- 	^ 0
- 
- 	!

Item was removed:
- ----- Method: InputSensor>>primSetInterruptKey: (in category 'private') -----
- primSetInterruptKey: anInteger
- 	"Primitive. Register the given keycode as the user interrupt key. The low byte of the keycode is the ISO character and its next four bits are the Smalltalk modifer bits <cmd><opt><ctrl><shift>."
- 
- 	<primitive: 133>
- 	^self primitiveFailed
- "Note: This primitive is obsolete with the new event driven architecture in which EventSensor can handle the interrupts itself. However, for supporting older images running on newer VMs the primitive must still be implemented."!

Item was removed:
- ----- Method: InputSensor>>primTabletGetParameters: (in category 'private') -----
- primTabletGetParameters: cursorIndex
- 	"Answer the pen tablet parameters. For parameters that differ from cursor to cursor, answer those associated with the cursor having the given index. Answer nil if there is no pen tablet. The parameters are:
- 	1. tablet width, in tablet units
- 	2. tablet height, in tablet units
- 	3. number of tablet units per inch
- 	4. number of cursors (pens, pucks, etc; some tablets have more than one)
- 	5. this cursor index
- 	6. and 7. x scale and x offset for scaling tablet coordintes (e.g., to fit the screen)
- 	8. and 9. y scale and y offset for scaling tablet coordintes  (e.g., to fit the screen)
- 	10. number of pressure levels
- 	11. presure threshold needed close pen tip switch 
- 	12. number of pen tilt angles"
- 
- 	<primitive: 'primitiveGetTabletParameters' module: 'JoystickTabletPlugin'>
- 	^ nil
- !

Item was removed:
- ----- Method: InputSensor>>primTabletRead: (in category 'private') -----
- primTabletRead: cursorIndex
- 	"Answer the pen tablet data for the cursor having the given index. Answer nil if there is no pen tablet. The data is:
- 	1. index of the cursor to which this data applies
- 	2. timestamp of the last state chance for this cursor
- 	3., 4., and 5. x, y, and z coordinates of the cursor (z is typically 0)
- 	6. and 7. xTilt and yTilt of the cursor; (signed)
- 	8. type of cursor (0 = unknown, 1 = pen, 2 = puck, 3 = eraser)
- 	9. cursor buttons
- 	10. cursor pressure, downward
- 	11. cursor pressure, tangential
- 	12. flags"
- 
- 	<primitive: 'primitiveReadTablet' module: 'JoystickTabletPlugin'>
- 	self primitiveFailed
- !

Item was removed:
- ----- Method: InputSensor>>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 primMouseButtons anyMask: 32!

Item was removed:
- ----- Method: InputSensor>>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 primMouseButtons bitAnd: 7) = 4
- !

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

Item was removed:
- ----- Method: InputSensor>>tabletExtent (in category 'tablet') -----
- tabletExtent
- 	"Answer the full tablet extent in tablet coordinates."
- 
- 	| params |
- 	params := self primTabletGetParameters: 1.
- 	params ifNil: [^ self error: 'no tablet available'].
- 	^ (params at: 1)@(params at: 2)
- !

Item was removed:
- ----- Method: InputSensor>>tabletPoint (in category 'tablet') -----
- tabletPoint
- 	"Answer the current position of the first tablet pointing device (pen, puck, or eraser) in tablet coordinates."
- 
- 	| data |
- 	data := self primTabletRead: 1.  "state of first/primary pen"
- 	^ (data at: 3) @ (data at: 4)
- !

Item was removed:
- ----- Method: InputSensor>>tabletPressure (in category 'tablet') -----
- tabletPressure
- 	"Answer the current pressure of the first tablet pointing device (pen, puck, or eraser), a number between 0.0 (no pressure) and 1.0 (max pressure)"
- 
- 	| params data |
- 	params := self primTabletGetParameters: 1.
- 	params ifNil: [^ self].
- 	data := self primTabletRead: 1.  "state of first/primary pen"
- 	^ (data at: 10) asFloat / ((params at: 10) - 1)
- !

Item was removed:
- ----- Method: InputSensor>>tabletTimestamp (in category 'tablet') -----
- tabletTimestamp
- 	"Answer the time (in tablet clock ticks) at which the tablet's primary pen last changed state. This can be used in polling loops; if this timestamp hasn't changed, then the pen state hasn't changed either."
- 
- 	| data |
- 	data := self primTabletRead: 1.  "state of first/primary pen"
- 	^ data at: 2
- !

Item was removed:
- ----- Method: InputSensor>>waitButton (in category 'mouse') -----
- waitButton
- 	"Wait for the user to press any mouse button and then answer with the 
- 	current location of the cursor."
- 
- 	| delay |
- 	delay := Delay forMilliseconds: 50.
- 	[self anyButtonPressed] whileFalse: [ delay wait ].
- 	^self cursorPoint
- !

Item was removed:
- ----- Method: InputSensor>>waitButtonOrKeyboard (in category 'mouse') -----
- waitButtonOrKeyboard
- 	"Wait for the user to press either any mouse button or any key. 
- 	Answer the current cursor location or nil if a keypress occured."
- 
- 	| delay |
- 	delay := Delay forMilliseconds: 50.
- 	[self anyButtonPressed]
- 		whileFalse: [delay wait.
- 			self keyboardPressed
- 				ifTrue: [^ nil]].
- 	^ self cursorPoint
- !

Item was removed:
- ----- Method: InputSensor>>waitClickButton (in category 'mouse') -----
- waitClickButton
- 	"Wait for the user to click (press and then release) any mouse button and 
- 	then answer with the current location of the cursor."
- 
- 	self waitButton.
- 	^self waitNoButton!

Item was removed:
- ----- Method: InputSensor>>waitNoButton (in category 'mouse') -----
- waitNoButton
- 	"Wait for the user to release any mouse button and then answer the current location of the cursor."
- 
- 	| delay |
- 	delay := Delay forMilliseconds: 50.
- 	[self anyButtonPressed] whileTrue: [ delay wait].
- 	^self cursorPoint
- !

Item was removed:
- ----- Method: InputSensor>>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 primMouseButtons bitAnd: 7) = 2
- !



More information about the Squeak-dev mailing list