wheel mouse support in UI

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index ebcda6685b42694c75efacf9f59822e05a930d09..baa352b993ca06d7b929ac26b2216c49e6f329db 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -5,11 +5,33 @@
 - rollovers broken with menus\r
 - menu dragging\r
 - fix up the min thumb size hack\r
-- nicer scrollbars with up/down buttons\r
 - gaps in pack layout\r
 - fix listener prompt display after presentation commands invoked\r
 - theme abstraction in ui\r
 \r
++ ui:\r
+\r
+- find out why so many small bignums get consed\r
+- repaint only dirty regions of the screen\r
+- faster mouse tracking\r
+- binary search to locate visible children of packs\r
+- rewrite frame layout for new style\r
+- an interior paint that is only painted on rollover and mouse press;\r
+  use it for menu items. give menus a gradient background\r
+- scroll bar: more intuitive behavior when clicking inside the elevator\r
+- timers\r
+- nicer scrollbars with up/down buttons\r
+- icons\r
+- use incremental strategy for all pack layouts where possible\r
+- multiline editing in listener\r
+- sort out clipping off-by-one flaw when filling rectangles\r
+\r
++ tutorial:\r
+\r
+- multiline code snippets\r
+- s-expression text styling language\r
+- word wrap\r
+\r
 + misc\r
 \r
 Investigate:\r
@@ -21,7 +43,6 @@ Investigate:
 \r
 - http keep alive, and range get\r
 - code walker & exceptions\r
-- faster repaint\r
 \r
 + ffi:\r
 \r

diff --git a/library/ui/hierarchy.factor b/library/ui/hierarchy.factor
index d28e562d3ac1589d5287bcf4fc8b84b0a6b50a3d..7fe2d8f21db8561ef9749cb8a4786d30a2c43e98 100644 (file)
--- a/library/ui/hierarchy.factor
+++ b/library/ui/hierarchy.factor
@@ -41,10 +41,11 @@ sequences vectors ;
     dup [ dup gadget-parent parents cons ] when ;
 
 : each-parent ( gadget quot -- ? )
-    #! Keep executing the quotation on higher and higher
-    #! parents until it returns f.
     >r parents r> all? ; inline
 
+: find-parent ( gadget quot -- ? )
+    >r parents r> find nip ; inline
+
 : screen-loc ( gadget -- point )
     #! The position of the gadget on the screen.
     parents { 0 0 0 } [ rectangle-loc v+ ] reduce ;

diff --git a/library/ui/scrolling.factor b/library/ui/scrolling.factor
index 09f4ae73bb03bc07f6cb60bc3a9f2cbad24dacd8..929fdd4cb4a10e5116833545f973ad24b0faa125 100644 (file)
--- a/library/ui/scrolling.factor
+++ b/library/ui/scrolling.factor
@@ -13,7 +13,7 @@ TUPLE: viewport origin bottom? ;
 : fix-scroll ( origin viewport -- origin )
     dup rectangle-dim swap viewport-dim v- vmax { 0 0 0 } vmin ;
 
-: scroll ( origin viewport -- )
+: scroll-viewport ( origin viewport -- )
     [ fix-scroll ] keep [ set-viewport-origin ] keep relayout ;
 
 C: viewport ( content -- viewport )
@@ -50,7 +50,13 @@ M: viewport focusable-child* ( viewport -- gadget )
 
 ! The offset slot is the y co-ordinate of the mouse relative to
 ! the thumb when it was clicked.
-TUPLE: slider viewport thumb vector ;
+TUPLE: slider thumb vector ;
+
+: slider-scroller ( slider -- scroller )
+    [ scroller? ] find-parent ;
+
+: slider-viewport ( slider -- viewport )
+    slider-scroller scroller-viewport ;
 
 : >thumb ( pos slider -- pos )
     slider-viewport visible-portion v* ;
@@ -65,9 +71,13 @@ TUPLE: slider viewport thumb vector ;
 : slider-pos ( slider pos -- pos )
     hand pick relative v+ over slider-vector v* swap >viewport ;
 
+: scroll ( origin scroller -- )
+    [ scroller-viewport scroll-viewport ] keep
+    dup scroller-x relayout scroller-y relayout ;
+
 : slider-click ( slider pos -- )
     dupd slider-pos over slider-current v+
-    over slider-viewport scroll relayout ;
+    swap slider-scroller scroll ;
 
 : slider-motion ( slider -- )
     hand hand-click-rel slider-click ;
@@ -89,24 +99,23 @@ TUPLE: slider viewport thumb vector ;
 : slider-actions ( slider -- )
     [ { 0 0 0 } slider-click ] [ button-down 1 ] set-action ;
 
-C: slider ( viewport vector -- slider )
+C: slider ( vector -- slider )
     <plain-gadget> over set-delegate
     dup [ 128 128 128 ] background set-paint-prop
     [ set-slider-vector ] keep
-    [ set-slider-viewport ] keep
     <thumb> over add-thumb
     dup slider-actions ;
 
-: <x-slider> ( viewport -- slider ) { 1 0 0 } <slider> ;
+: <x-slider> ( -- slider ) { 1 0 0 } <slider> ;
 
-: <y-slider> ( viewport -- slider ) { 0 1 0 } <slider> ;
+: <y-slider> ( -- slider ) { 0 1 0 } <slider> ;
 
 : thumb-loc ( slider -- loc )
     dup slider-viewport
     dup viewport-origin* swap fix-scroll
     vneg swap >thumb ;
 
-: slider-dim { 16 16 16 } ;
+: slider-dim { 12 12 12 } ;
 
 : thumb-dim ( slider -- h )
     [ rectangle-dim dup ] keep >thumb slider-dim vmax vmin ;
@@ -134,15 +143,20 @@ TUPLE: scroller viewport x y ;
 : scroll>bottom ( gadget -- )
     [ scroll>bottom ] swap handle-gesture drop ;
 
+: scroll-by ( scroller amount -- )
+    over scroller-viewport viewport-origin v+ swap scroll ;
+
 : scroller-actions ( scroller -- )
-    [ (scroll>bottom) ] [ scroll>bottom ] set-action ;
+    dup [ (scroll>bottom) ] [ scroll>bottom ] set-action
+    dup [ { 0 32 0 } scroll-by ] [ button-down 4 ] set-action
+    [ { 0 -32 0 } scroll-by ] [ button-down 5 ] set-action ;
 
 C: scroller ( gadget -- scroller )
     #! Wrap a scrolling pane around the gadget.
     <frame> over set-delegate
     [ >r <viewport> r> add-viewport ] keep
-    dup scroller-viewport <x-slider> over add-x-slider
-    dup scroller-viewport <y-slider> over add-y-slider
+    <x-slider> over add-x-slider
+    <y-slider> over add-y-slider
     dup scroller-actions ;
 
 M: scroller focusable-child* ( viewport -- gadget )

diff --git a/library/ui/world.factor b/library/ui/world.factor
index 57a3da2a3bf3aa5c025862b6acd4dbcb38ec43cb..cb46e1d4027603c8d310e7ca320b79f36ace756a 100644 (file)
--- a/library/ui/world.factor
+++ b/library/ui/world.factor
@@ -54,7 +54,7 @@ DEFER: handle-event
 
 : world-step ( -- ? )
     world get dup world-invalid >r layout-world r>
-    [ draw-world ] [ drop ] ifte ;
+    [ hand update-hand draw-world ] [ drop ] ifte ;
 
 : next-event ( -- event ? )
     <event> dup SDL_PollEvent ;