Pharo 3.0: Horizontal Mouse Wheel

HScroll.cs

'From Pharo3.0 of 18 March 2013 [Latest update: #30862] on 10 February 2015 at 1:57:00.736016 pm'!

!GeneralScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'SeanDeNigris 2/10/2015 13:50'!
mouseWheel: event 
	"Handle a mouseWheel event."
	
	(self scrollTarget handlesMouseWheel: event)
		ifTrue: [^self scrollTarget mouseWheel: event]. "pass on"
	
	event isUp ifTrue: [ ^ vScrollbar scrollUp: 3 ].
	event isDown ifTrue: [ ^ vScrollbar scrollDown: 3 ].
	event isLeft  ifTrue: [ ^ hScrollbar scrollLeft: 3 ].
	event isRight  ifTrue: [ ^ hScrollbar scrollRight: 3 ].! !


!AthensSceneView methodsFor: 'event handling' stamp: 'SeanDeNigris 2/10/2015 13:41'!
mouseWheel: event


	"Handle a mouseWheel event."
	
	| center zoom  |
	
	center := transform inverseTransform: (event cursorPoint - bounds origin).

	zoom := 1.
	
	event isUp ifTrue: [ zoom := 1.25 ].
	event isDown ifTrue: [ zoom := 1/1.25 ].
	
	
	(self inState: #zooming) ifTrue: [   
		self updateZoom: zoom cursor: event cursorPoint.
	] ifFalse: [
		self startZooming: zoom center: center.
	]  ! !


!ScrollBar methodsFor: 'scrolling' stamp: 'SeanDeNigris 2/10/2015 13:48'!
scrollRight: count
	self scrollDown: count! !

!ScrollBar methodsFor: 'scrolling' stamp: 'SeanDeNigris 2/10/2015 13:48'!
scrollLeft: count
	self scrollUp: count! !


!HandMorph methodsFor: 'private events' stamp: 'SeanDeNigris 2/10/2015 13:36'!
generateKeyboardEvent: evtBuf
	"Generate the appropriate mouse event for the given raw event buffer"

	| buttons modifiers type pressType stamp charCode keyValue keyEvent |
	stamp := evtBuf second.
	stamp = 0 ifTrue: [stamp := Time millisecondClockValue].
	pressType := evtBuf fourth.
	pressType = EventKeyDown
		ifTrue: [
			type := #keyDown.
			lastKeyScanCode := evtBuf third].
	pressType = EventKeyUp ifTrue: [type := #keyUp].
	pressType = EventKeyChar ifTrue: [
		type := #keystroke].
	modifiers := evtBuf fifth.
	buttons := modifiers bitShift: 3.
	keyValue := evtBuf third. 
	charCode := evtBuf sixth.

	type = #keystroke
		ifTrue: [combinedChar
			ifNil: [
				| peekedEvent |
				peekedEvent := Sensor peekEvent.
				(peekedEvent notNil
					and: [peekedEvent fourth = EventKeyDown])
					ifTrue: [
						(CombinedChar isCompositionCharacter: charCode)
							ifTrue: [
								combinedChar := CombinedChar new.
								combinedChar simpleAdd: charCode asCharacter.
								(combinedChar combinesWith: peekedEvent third asCharacter)
									ifTrue: [^nil].
								]]]
			ifNotNil: [
				(combinedChar simpleAdd: charCode asCharacter)
					ifTrue: [charCode := combinedChar combined charCode].
				combinedChar := nil]].

	self flag: #fixme.
	"This piece of code handles the creation of scrolling events. When a scroll is done by the user, the VM forwards a keystroke event with the up/down key. So we reconvert it to a MouseWheelEvent in that case."
	(type = #keystroke and: [(buttons anyMask: 16) and: [ charCode asCharacter isArrow ]])
		ifTrue: [^ MouseWheelEvent
					fromCharacter: charCode asCharacter
					position: lastMouseEvent cursorPoint
					buttons: buttons
					hand: self
					stamp: stamp].

	keyEvent := KeyboardEvent new
		setType: type
		buttons: buttons
		position: self position
		keyValue: keyValue
		charCode: charCode
		hand: self
		stamp: stamp.
	keyEvent scanCode: lastKeyScanCode.
	^keyEvent
! !

!HandMorph methodsFor: '*EventModel' stamp: 'SeanDeNigris 2/10/2015 13:40'!
handleKeyboardInputEvent: sysEvent
	"For the moment just to give a try, working on generateKeyboardEvent2: "

	| charCode keyValue keyEvent |

	recentModifiers := sysEvent modifiers.

	sysEvent isKeyDown ifTrue: [ lastKeyScanCode := sysEvent charCode].
	keyValue := sysEvent charCode. 
	charCode := sysEvent utf32Code.
	
	"Adjustments to provide consistent key value data for different VM's:
	- charCode always contains unicode code point.
	 - keyValue contains 0 if input is outside legacy range"
	"If there is no unicode data in the event, assume keyValue contains a correct (<256) Unicode codepoint, and use that"
	(charCode isNil
		or: [charCode = 0])
		ifTrue: [charCode := keyValue].
	"If charCode is not single-byte, we definately have Unicode input. Nil keyValue to avoid garbage values from som VMs."	
	charCode > 255 ifTrue: [keyValue := 0].

"

	This should be checked... 
	
	sysEvent isKeyStroke
		ifTrue: [
			combinedChar 
				ifNil: [
					(CombinedChar isCompositionCharacter: charCode) ifTrue: [ 
						combinedChar := CombinedChar new.
						combinedChar simpleAdd: charCode asCharacter.
						^ nil ].
				] ifNotNil: [
					(combinedChar simpleAdd: charCode asCharacter)
						ifTrue: [charCode := combinedChar combined charCode].
					combinedChar := nil]					
			].
"
		sysEvent isMouseWheel
		ifTrue: [^ MouseWheelEvent
					fromCharacter: charCode asCharacter
					position: lastMouseEvent cursorPoint
					buttons: sysEvent buttons
					hand: self
					stamp: sysEvent timeStamp].	
	keyEvent := KeyboardEvent new
		setType: sysEvent pressType
		buttons: sysEvent buttons
		position: self position
		keyValue: keyValue
		charCode: charCode
		hand: self
		stamp: sysEvent timeStamp.
	keyEvent scanCode: lastKeyScanCode.
	
	^keyEvent
! !


!ScrollPane methodsFor: '*Polymorph-Widgets' stamp: 'SeanDeNigris 2/10/2015 13:50'!
mouseWheel: event 
	"Handle a mouseWheel event."
	
	event isUp ifTrue: [ ^ scrollBar scrollUp: 3 ].
	event isDown ifTrue: [ ^ scrollBar scrollDown: 3 ].
	event isLeft  ifTrue: [ ^ hScrollBar scrollLeft: 3 ].
	event isRight  ifTrue: [ ^ hScrollBar scrollRight: 3 ].! !


!MouseWheelEvent methodsFor: 'testing' stamp: 'SeanDeNigris 2/10/2015 13:38'!
isLeft

	^ direction = #left! !

!MouseWheelEvent methodsFor: 'testing' stamp: 'SeanDeNigris 2/10/2015 13:38'!
isUp

	^ direction = #up! !

!MouseWheelEvent methodsFor: 'testing' stamp: 'SeanDeNigris 2/10/2015 13:38'!
isDown

	^ direction = #down! !

!MouseWheelEvent methodsFor: 'testing' stamp: 'SeanDeNigris 2/10/2015 13:38'!
isRight

	^ direction = #right! !


!MouseWheelEvent class methodsFor: 'private' stamp: 'SeanDeNigris 2/10/2015 13:35'!
directionFrom: arrowCharacter

	arrowCharacter = Character arrowUp ifTrue: [ ^ #up ].
	arrowCharacter = Character arrowDown ifTrue: [ ^ #down ].
	arrowCharacter = Character arrowLeft ifTrue: [ ^ #left ].
	arrowCharacter = Character arrowRight ifTrue: [ ^ #right ].! !

!MouseWheelEvent class methodsFor: 'instance creation' stamp: 'SeanDeNigris 2/10/2015 13:34'!
fromCharacter: aCharacter position: aPoint buttons: evtButtons hand: evtHand stamp: stamp

	| direction |
	direction := self directionFrom: aCharacter.
	^ self new
		setType: #mouseWheel
		position: aPoint
		direction: direction
		buttons: evtButtons
		hand: evtHand
		stamp: stamp! !


!Character methodsFor: 'testing' stamp: 'SeanDeNigris 2/10/2015 13:26'!
isArrow

	^ { Character arrowUp. Character arrowDown. Character arrowLeft. Character arrowRight } includes: self! !


!MouseWheelEvent class reorganize!
(#private directionFrom:)
(#'instance creation' fromCharacter:position:buttons:hand:stamp:)
!