diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index ebcda6685b..baa352b993 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -5,11 +5,33 @@ - rollovers broken with menus - menu dragging - fix up the min thumb size hack -- nicer scrollbars with up/down buttons - gaps in pack layout - fix listener prompt display after presentation commands invoked - theme abstraction in ui ++ ui: + +- find out why so many small bignums get consed +- repaint only dirty regions of the screen +- faster mouse tracking +- binary search to locate visible children of packs +- rewrite frame layout for new style +- an interior paint that is only painted on rollover and mouse press; + use it for menu items. give menus a gradient background +- scroll bar: more intuitive behavior when clicking inside the elevator +- timers +- nicer scrollbars with up/down buttons +- icons +- use incremental strategy for all pack layouts where possible +- multiline editing in listener +- sort out clipping off-by-one flaw when filling rectangles + ++ tutorial: + +- multiline code snippets +- s-expression text styling language +- word wrap + + misc Investigate: @@ -21,7 +43,6 @@ Investigate: - http keep alive, and range get - code walker & exceptions -- faster repaint + ffi: diff --git a/library/ui/hierarchy.factor b/library/ui/hierarchy.factor index d28e562d3a..7fe2d8f21d 100644 --- 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 09f4ae73bb..929fdd4cb4 100644 --- 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 ) over set-delegate dup [ 128 128 128 ] background set-paint-prop [ set-slider-vector ] keep - [ set-slider-viewport ] keep over add-thumb dup slider-actions ; -: ( viewport -- slider ) { 1 0 0 } ; +: ( -- slider ) { 1 0 0 } ; -: ( viewport -- slider ) { 0 1 0 } ; +: ( -- slider ) { 0 1 0 } ; : 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. over set-delegate [ >r r> add-viewport ] keep - dup scroller-viewport over add-x-slider - dup scroller-viewport over add-y-slider + over add-x-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 57a3da2a3b..cb46e1d402 100644 --- 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 ? ) dup SDL_PollEvent ;