From 6addf44ad028b01d02cd2af0ccffb4b2a0b1e8da Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Thu, 23 Mar 2006 21:01:47 +0000
Subject: [PATCH] Wheel mouse support

---
 TODO.FACTOR.txt           |  2 ++
 library/ui/hand.factor    |  2 +-
 library/x11/events.factor | 14 ++++++++++++--
 library/x11/ui.factor     |  3 +++
 4 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index f7de6dfc56..14dbaf1483 100644
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -21,6 +21,7 @@
 
 + ui/help:
 
+- collapsing an outliner is broken
 - x11:
   - dealloc glx context, call xfree, etc
   - input methods
@@ -30,6 +31,7 @@
   - expired aliens in view hash
   - don't multiplex in the event loop if there is no pending i/o
 - hand is broken by design
+  - maybe eliminate mouse-overs...?
 - speed up ideas:
   - only do clipping for certain gadgets
   - use glRect
diff --git a/library/ui/hand.factor b/library/ui/hand.factor
index db601965a9..71dad2728e 100644
--- a/library/ui/hand.factor
+++ b/library/ui/hand.factor
@@ -39,7 +39,7 @@ V{ } clone hand-buttons set-global
     dup hand-buttons get-global delete
     [ button-up ] button-gesture ;
 
-: send-scroll-wheel ( up/down -- )
+: send-wheel ( up/down -- )
     [ wheel-up ] [ wheel-down ] ?
     hand-gadget get-global handle-gesture drop ;
 
diff --git a/library/x11/events.factor b/library/x11/events.factor
index ac042e06a4..cb65d321c8 100644
--- a/library/x11/events.factor
+++ b/library/x11/events.factor
@@ -10,6 +10,8 @@ GENERIC: button-down-event ( event window -- )
 
 GENERIC: button-up-event ( event window -- )
 
+GENERIC: wheel-event ( event window -- )
+
 GENERIC: motion-event ( event window -- )
 
 GENERIC: key-down-event ( event window -- )
@@ -33,11 +35,19 @@ GENERIC: client-event ( event window -- )
     QueuedAfterFlush events-queued 0 >
     [ next-event ] [ ui-step wait-event ] if ;
 
+: wheel? ( event -- ? ) XButtonEvent-button { 4 5 } member? ;
+
+: button-down-event$ ( event window -- )
+    over wheel? [ wheel-event ] [ button-down-event ] if ;
+
+: button-up-event$ ( event window -- )
+    over wheel? [ 2drop ] [ button-up-event ] if ;
+
 : handle-event ( event window -- )
     over XAnyEvent-type {
         { [ dup ConfigureNotify = ] [ drop resize-event ] }
-        { [ dup ButtonPress = ] [ drop button-down-event ] }
-        { [ dup ButtonRelease = ] [ drop button-up-event ] }
+        { [ dup ButtonPress = ] [ drop button-down-event$ ] }
+        { [ dup ButtonRelease = ] [ drop button-up-event$ ] }
         { [ dup MotionNotify = ] [ drop motion-event ] }
         { [ dup KeyPress = ] [ drop key-down-event ] }
         { [ dup KeyRelease = ] [ drop key-up-event ] }
diff --git a/library/x11/ui.factor b/library/x11/ui.factor
index 488c38b2d0..49876eb47d 100644
--- a/library/x11/ui.factor
+++ b/library/x11/ui.factor
@@ -22,6 +22,9 @@ M: world button-down-event ( event world -- )
 M: world button-up-event ( event world -- )
     drop XButtonEvent-button send-button-up ;
 
+M: world wheel-event ( event world -- )
+    drop XButtonEvent-button H{ { 4 -1 } { 5 1 } } send-wheel ;
+
 M: world motion-event ( event world -- )
     >r dup XMotionEvent-x swap XMotionEvent-y 0 3array r>
     move-hand ;