Horizontal scrolling with the mouse wheel is now supported

TODO.FACTOR.txt

@@ -1,37 +1,29 @@
 - auto-invoke code gc
 - fix alien-callback/SEH bug on win32
-- maybe simplify list into displaying list a sequence of strings
 - x11: scroll up/down wiggles caret
-- slider needs to be modelized
-- some way of intercepting all gestures
-- better help result ranking
-- help search looks funny
-- menus should not require mouse to be held
 - tab completion: add a USE: if necessary
-- completion is not ideal: eg, search for "buttons"
+- cocoa: horizontal wheel scrolling
-- live search: timer delay would be nice
+- rollover is not updated on window focus changes
+- cocoa: windows are not updated while resizing
 
 + ui:
 
-- [ ] write in the UI breaks stuff
+- command presentation shouldn't really be a presentation at all
-- pane output in UI should use less memory
+- completion is not ideal: eg, search for "buttons"
+- live search: timer delay would be nice
+- some way of intercepting all gestures
+- slider needs to be modelized
+- better help result ranking
+- help search looks funny
+- menus should not require mouse to be held
 - variable width word wrap
-  - needs layout tricks
-- add-gadget, model-changed, set-model should compile
 - graphical module manager tool
-  - list of modules -- loaded, not loaded
-  - each module has a list of files
-  - modules can be (re)loaded
-  - keyboard navigation
 - ui browser: show currently selected vocab & words
 - auto-update browser and help when sources reload
 - how do we refer to command shortcuts in the docs?
-- figure out if we need both set-model and set-model*
 - roundoff is still not quite right with tracks
 - fix top level window positioning
-- x11.app has a problem with A+ keys
 - services do not launch if factor not running
-- fix ui listener delay
 - editor:
   - double/triple click
   - autoscroll
@@ -39,19 +31,9 @@
   - more efficient multi-line inserts
   - write "foo| " and put caret at | then select word element: selects
     space
-- fonts/ should go inside the .app -- we need multi-tier resource-path
-- should be possible to drop an image file on the .app to run it
-- support x11's large selections, if needed
-- own-selection violates ICCCM
-- cocoa: windows are not updated while resizing
 - grid slows down with 2000 lines
 - see if its possible to only repaint dirty regions
-- x11 title bars are funny
+- polish OS X menu bar code
-- rollover is not updated on window focus changes
-- x11 input methods
-- cocoa:
-  - horizontal wheel scrolling
-  - polish OS X menu bar code
 - structure editor
 
 + module system:
@@ -59,7 +41,6 @@
 - convention for main entry point of a module
 - convention for main help article of a module
 - track a list of assets loaded from each module's file
-- generic 'define ( asset def -- )'
 - C types should be words
   - TYPEDEF: float { ... } { ... } ;   ==> \ float T{ c-type ... } "c-type" swp
   - TYPEDEF: float FTFloat ;  ==> \ float \ FTFloat "c-type" swp
@@ -71,12 +52,8 @@
 
 - more compact relocation info
 - cocoa: support real redefinition
-- problem if major gc happens during relocation
+- relocation should not cons at all
-  - in fact relocation should not cons at all
 - stdcall callbacks
-- see if alien calls can be made faster
-- compiler tests are not as reliable now because of try-compile usage
-  - we can just do [ t ] [ \ foo compiled? ] unit-test
 - [ [ dup call ] dup call ] infer hangs
 - callstack overflow when compiling mutually recursive inline words
 - test what is done in the case of an invalid declaration on an inline
@@ -105,9 +82,7 @@
 - minor GC takes too long now, we should card mark code heap
 - buffer-ptr should be an alien
 - swap nappend ==> nappend
-- sometimes darcs get fails with the httpd
 - gdb triggers 'mutliple i/o ops on port' error
-- factorcode httpd crashed: bad file descriptor
 - growable data heap
 - incremental GC
 - UDP

library/ui/cocoa/view-utils.factor

@@ -100,8 +100,10 @@ opengl sequences ;
     mouse-location rot window send-button-up ;
 
 : send-wheel$ ( view event -- )
-    [ -> deltaY 0 > ] 2keep mouse-location
+    over >r
-    rot window send-wheel ;
+    dup -> deltaX sgn neg over -> deltaY sgn neg 2array -rot
+    mouse-location
+    r> window send-wheel ;
 
 : send-action$ ( view event gesture -- junk )
     >r drop window r> send-action f ;

library/ui/gadgets/scrolling.factor

@@ -16,17 +16,21 @@ TUPLE: scroller viewport x y follows ;
 
 : find-scroller [ scroller? ] find-parent ;
 
-: scroll-up-line scroller-y -1 swap slide-by-line ;
-
-: scroll-down-line scroller-y 1 swap slide-by-line ;
-
 : scroll-up-page scroller-y -1 swap slide-by-page ;
 
 : scroll-down-page scroller-y 1 swap slide-by-page ;
 
+: scroll-up-line scroller-y -1 swap slide-by-line ;
+
+: scroll-down-line scroller-y 1 swap slide-by-line ;
+
+: do-mouse-scroll ( scroller -- )
+    scroll-direction get-global first2
+    pick scroller-y slide-by-line
+    swap scroller-x slide-by-line ;
+
 scroller H{
-    { T{ wheel-up } [ scroll-up-line ] }
+    { T{ mouse-scroll } [ do-mouse-scroll ] }
-    { T{ wheel-down } [ scroll-down-line ] }
     { T{ slider-changed } [ relayout-1 ] }
 } set-gestures
 

library/ui/gestures.factor

@@ -27,8 +27,7 @@ TUPLE: motion ;
 TUPLE: drag # ;
 TUPLE: button-up mods # ;
 TUPLE: button-down mods # ;
-TUPLE: wheel-up ;
+TUPLE: mouse-scroll ;
-TUPLE: wheel-down ;
 TUPLE: mouse-enter ;
 TUPLE: mouse-leave ;
 TUPLE: lose-focus ;
@@ -74,6 +73,9 @@ SYMBOL: hand-click-loc
 SYMBOL: hand-buttons
 V{ } clone hand-buttons set-global
 
+SYMBOL: scroll-direction
+{ 0 0 } scroll-direction set-global
+
 : button-gesture ( gesture -- )
     hand-clicked get-global 2dup handle-gesture [
         >r generalize-gesture r> handle-gesture drop
@@ -170,10 +172,11 @@ SYMBOL: menu-mode?
     dup button-up-# hand-buttons get-global delete
     button-gesture ;
 
-: send-wheel ( up/down loc world -- )
+: send-wheel ( direction loc world -- )
     move-hand
-    T{ wheel-up } T{ wheel-down } ?
+    scroll-direction set-global
-    hand-gadget get-global handle-gesture drop ;
+    T{ mouse-scroll } hand-gadget get-global handle-gesture
+    drop ;
 
 : send-action ( world gesture -- )
     swap world-focus handle-gesture drop ;

library/ui/x11/ui.factor

@@ -108,8 +108,11 @@ M: world button-up-event
     >r mouse-event>gesture >r <button-up> r> r>
     send-button-up ;
 
+: mouse-event>scroll-direction ( event -- pair )
+    XButtonEvent-button 4 = 1 -1 ? 0 swap 2array ;
+
 M: world wheel-event
-    >r dup XButtonEvent-button 4 = swap mouse-event-loc r>
+    >r dup mouse-event>scroll-direction swap mouse-event-loc r>
     send-wheel ;
 
 M: world enter-event motion-event ;