diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor index adcfdfb00d..bc07006d62 100644 --- a/basis/ui/gadgets/gadgets.factor +++ b/basis/ui/gadgets/gadgets.factor @@ -11,6 +11,7 @@ CONSTANT: horizontal { 1 0 } CONSTANT: vertical { 0 1 } TUPLE: gadget < rect +id pref-dim parent children @@ -28,7 +29,7 @@ model ; M: gadget equal? 2drop f ; -M: gadget hashcode* drop gadget hashcode* ; +M: gadget hashcode* nip [ [ \ gadget counter ] unless* ] change-id id>> ; M: gadget model-changed 2drop ; diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor index 41e983eb28..6f6e7ee95f 100644 --- a/basis/ui/gadgets/panes/panes.factor +++ b/basis/ui/gadgets/panes/panes.factor @@ -49,13 +49,13 @@ M: pane-stream stream-element-type drop +character+ ; : pane-caret&mark ( pane -- caret mark ) [ caret>> ] [ mark>> ] bi ; inline -: selected-children ( pane -- seq ) +: selected-subtree ( pane -- seq ) [ pane-caret&mark sort-pair ] keep gadget-subtree ; M: pane gadget-selection? pane-caret&mark and ; M: pane gadget-selection ( pane -- string/f ) - selected-children gadget-text ; + selected-subtree gadget-text ; : init-prototype ( pane -- pane ) +baseline+ >>align >>prototype ; inline @@ -72,32 +72,12 @@ M: pane gadget-selection ( pane -- string/f ) [ >>last-line ] [ 1 track-add ] bi dup prepare-last-line ; inline -GENERIC: draw-selection ( loc obj -- ) - -: if-fits ( rect quot -- ) - [ clip get origin get vneg offset-rect over contains-rect? ] dip - [ drop ] if ; inline - -M: gadget draw-selection ( loc gadget -- ) - swap offset-rect [ - rect-bounds gl-fill-rect - ] if-fits ; - -M: node draw-selection ( loc node -- ) - 2dup value>> swap offset-rect [ - drop 2dup - [ value>> loc>> v+ ] keep - children>> [ draw-selection ] with each - ] if-fits 2drop ; - -M: pane draw-gadget* +M: pane selected-children dup gadget-selection? [ - [ selection-color>> gl-color ] - [ - [ loc>> vneg ] keep selected-children - [ draw-selection ] with each - ] bi - ] [ drop ] if ; + [ selected-subtree leaves ] + [ selection-color>> ] + bi + ] [ drop f f ] if ; : scroll-pane ( pane -- ) dup scrolls?>> [ scroll>bottom ] [ drop ] if ; diff --git a/basis/ui/render/render.factor b/basis/ui/render/render.factor index 4c8f7c24e5..09c26fd271 100755 --- a/basis/ui/render/render.factor +++ b/basis/ui/render/render.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: math.rectangles math.vectors namespaces kernel accessors -combinators sequences opengl opengl.gl opengl.glu colors +assocs combinators sequences opengl opengl.gl opengl.glu colors colors.constants ui.gadgets ui.pens ; IN: ui.render @@ -55,21 +55,57 @@ SYMBOL: origin GENERIC: draw-children ( gadget -- ) +! For gadget selection +SYMBOL: selected-gadgets + +SYMBOL: selection-background + +GENERIC: selected-children ( gadget -- assoc/f selection-background ) + +M: gadget selected-children drop f f ; + +! For text rendering +SYMBOL: background + +SYMBOL: foreground + +GENERIC: gadget-background ( gadget -- color ) + +M: gadget gadget-background dup interior>> pen-background ; + +GENERIC: gadget-foreground ( gadget -- color ) + +M: gadget gadget-foreground dup interior>> pen-foreground ; + +> gl-fill-rect ; + +: draw-standard-background ( object -- ) + dup interior>> dup [ draw-interior ] [ 2drop ] if ; + +: draw-background ( gadget -- ) + origin get [ + [ + dup selected-gadgets get key? + [ draw-selection-background ] + [ draw-standard-background ] if + ] [ draw-gadget* ] bi + ] with-translation ; + +: draw-border ( object -- ) + dup boundary>> dup [ + origin get [ draw-boundary ] with-translation + ] [ 2drop ] if ; + +PRIVATE> + : (draw-gadget) ( gadget -- ) dup loc>> origin get v+ origin [ - [ - origin get [ - [ dup interior>> dup [ draw-interior ] [ 2drop ] if ] - [ draw-gadget* ] - bi - ] with-translation - ] - [ draw-children ] - [ - dup boundary>> dup [ - origin get [ draw-boundary ] with-translation - ] [ 2drop ] if - ] tri + [ draw-background ] [ draw-children ] [ draw-border ] tri ] with-variable ; : >absolute ( rect -- rect ) @@ -88,27 +124,24 @@ GENERIC: draw-children ( gadget -- ) [ [ (draw-gadget) ] with-clipping ] } cond ; -! For text rendering -SYMBOL: background - -SYMBOL: foreground - -GENERIC: gadget-background ( gadget -- color ) - -M: gadget gadget-background dup interior>> pen-background ; - -GENERIC: gadget-foreground ( gadget -- color ) - -M: gadget gadget-foreground dup interior>> pen-foreground ; - M: gadget draw-children - [ visible-children ] - [ gadget-background ] - [ gadget-foreground ] tri [ - [ foreground set ] when* - [ background set ] when* - [ draw-gadget ] each - ] with-scope ; + dup children>> [ + { + [ visible-children ] + [ selected-children ] + [ gadget-background ] + [ gadget-foreground ] + } cleave [ + + { + [ [ selected-gadgets set ] when* ] + [ [ selection-background set ] when* ] + [ [ background set ] when* ] + [ [ foreground set ] when* ] + } spread + [ draw-gadget ] each + ] with-scope + ] [ drop ] if ; CONSTANT: selection-color T{ rgba f 0.8 0.8 1.0 1.0 } diff --git a/basis/ui/traverse/traverse.factor b/basis/ui/traverse/traverse.factor index 63c656205c..9df084210d 100644 --- a/basis/ui/traverse/traverse.factor +++ b/basis/ui/traverse/traverse.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2007, 2008 Slava Pestov. +! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors namespaces make sequences kernel math arrays io -ui.gadgets generic combinators ; +ui.gadgets generic combinators fry sets ; IN: ui.traverse TUPLE: node value children ; @@ -85,3 +85,13 @@ M: node gadget-text* : gadget-at-path ( parent path -- gadget ) [ swap nth-gadget ] each ; + +GENERIC# leaves* 1 ( tree assoc -- ) + +M: node leaves* [ children>> ] dip leaves* ; + +M: array leaves* '[ _ leaves* ] each ; + +M: gadget leaves* conjoin ; + +: leaves ( tree -- assoc ) H{ } clone [ leaves* ] keep ; \ No newline at end of file