WindowSensor.st
branchdelegated_gc_jv
changeset 6801 f08006a3c9fe
parent 6800 f4acb46ba42e
child 6802 6d8acdfbfa08
--- a/WindowSensor.st	Tue Feb 03 13:48:45 2015 +0000
+++ b/WindowSensor.st	Thu Feb 05 12:55:23 2015 +0000
@@ -11,15 +11,17 @@
 "
 "{ Package: 'stx:libview' }"
 
+"{ NameSpace: Smalltalk }"
+
 Object subclass:#WindowSensor
 	instanceVariableNames:'eventSemaphore damage mouseAndKeyboard compressMotionEvents
 		ignoreUserInput exposeEventSemaphore catchExpose gotExpose
 		gotOtherEvent translateKeyboardEvents shiftDown ctrlDown metaDown
 		altDown leftButtonDown middleButtonDown rightButtonDown
 		eventListeners ignoreExposeEvents damageEventAccessLock
-		userEventAccessLock gotCompose compose1'
+		userEventAccessLock gotCompose compose1 collectedMouseWheelMotion'
 	classVariableNames:'ControlCEnabled ControlYEnabled ControlPeriodEnabled ComposeTable
-		EventListeners'
+		EventListeners MouseWheelThreshold MouseWheelScale'
 	poolDictionaries:''
 	category:'Interface-Support-UI'
 !
@@ -219,10 +221,6 @@
         WindowEvent KeyboardMap KeyboardForwarder EventListener
         GraphicsDevice DeviceWorkstation View
 "
-!
-
-version_CVS
-    ^ '$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.284.2.2 2015-01-29 09:54:04 stefan Exp $'
 ! !
 
 !WindowSensor class methodsFor:'initialization'!
@@ -236,7 +234,9 @@
 
     ComposeTable isNil ifTrue:[
         self initializeComposeKeyTable
-    ]
+    ].
+
+    MouseWheelScale := UserPreferences current mouseWheelScale.
 
     "
      WindowSensor initialize
@@ -566,6 +566,24 @@
 
     "Created: 22.4.1996 / 14:06:43 / cg"
     "Modified: 24.4.1996 / 16:37:08 / cg"
+!
+
+mouseWheelScale
+    "if set, mouse wheel motions are scaled by this number"
+
+    ^ MouseWheelScale ? 1
+!
+
+mouseWheelScale:aNumber
+    "if set, mouse wheel motions are scaled by this number"
+
+    MouseWheelScale := aNumber
+!
+
+mouseWheelThreshold
+    "if set, mouse wheel motions are only reported if the scaled amount is above this"
+
+    ^ 10 / MouseWheelScale
 ! !
 
 !WindowSensor class methodsFor:'instance creation'!
@@ -1965,7 +1983,7 @@
     eventListeners notNil ifTrue:[
         "/ be prepared that a listener removes itself while we iterate...
         eventListeners copy do:[:aListener |
-            (aListener notNil and:[(aListener processEvent:anEvent) == true]) ifTrue:[
+            (aListener processEvent:anEvent) == true ifTrue:[
                 anyListenerReturnedTrue := true
             ]
         ]
@@ -2602,6 +2620,7 @@
 
     shiftDown := ctrlDown := altDown := metaDown := false.
     leftButtonDown := middleButtonDown := rightButtonDown := false.
+    collectedMouseWheelMotion := 0.
 
     "Modified: / 30-07-2013 / 19:27:46 / cg"
 !
@@ -2777,13 +2796,16 @@
     "Modified: / 18.6.1998 / 09:29:18 / cg"
 !
 
-hasEvent:type for:aView withArguments:args 
+hasEvent:type for:aView withArguments:argsOrNil 
     "return true, if a specific event is pending in my queues.
      Type is the type of event, args are the arguments.
      If the argument, aView is nil, the information is regarding any
      view (i.e. is there an event for any of my views);
      otherwise, the information is regarding to that specific view."
 
+    |args|
+
+    args := argsOrNil ? #().
     ^ self
         hasEvent:type 
         for:aView 
@@ -2940,6 +2962,48 @@
     "Modified: / 18.6.1998 / 08:57:00 / cg"
 !
 
+hasUserEvent:type for:aView withArguments:argsOrNil 
+    "return true, if a specific user event (non damage) is pending in my queues.
+     Type is the type of event, args are the arguments.
+     If the argument, aView is nil, the information is regarding any
+     view (i.e. is there an event for any of my views);
+     otherwise, the information is regarding to that specific view."
+
+    |args|
+
+    args := argsOrNil ? #().
+    ^ self
+        hasUserEvent:type 
+        for:aView 
+        withMatchingArguments:[:evArgs | evArgs = args]
+!
+
+hasUserEvent:type for:aReceiverOrNil withMatchingArguments:argMatchBlock
+    "return true, if a specific event is pending in my user event queue.
+     Type is the type of event, dType the corresponding device event.
+     If the argument, aReceiverOrNil is nil, the information is regarding any
+     view (i.e. is there an event for any of my views);
+     otherwise, the information is regarding to that specific view."
+
+    mouseAndKeyboard size ~~ 0 ifTrue:[
+        mouseAndKeyboard do:[:anEvent |
+            anEvent notNil ifTrue:[
+                (aReceiverOrNil isNil or:[anEvent receiver == aReceiverOrNil]) ifTrue:[
+                    (type isNil or:[anEvent type == type]) ifTrue:[
+                        (argMatchBlock value:anEvent arguments) ifTrue:[
+                            ^ true
+                        ].
+                    ].
+                ]
+            ].
+        ]
+    ].
+    ^ false
+
+    "Created: / 17.6.1998 / 12:55:54 / cg"
+    "Modified: / 18.6.1998 / 08:57:00 / cg"
+!
+
 hasUserEventFor:aView 
     "return true, if any user event (i.e. key or button events) are pending.
      If the argument, aView is nil, the information is regarding any
@@ -3272,5 +3336,15 @@
     "Modified: 10.2.1997 / 13:30:43 / cg"
 ! !
 
+!WindowSensor class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.292 2015/02/05 08:54:11 cg Exp $'
+!
+
+version_CVS
+    ^ '$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.292 2015/02/05 08:54:11 cg Exp $'
+! !
+
 
 WindowSensor initialize!