Fix UI pane selection
parent
0db52b0545
commit
4f19f9b2c1
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 )
|
||||
<shelf> +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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: draw-selection-background ( gadget -- )
|
||||
selection-background get background set
|
||||
selection-background get gl-color
|
||||
[ { 0 0 } ] dip dim>> 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 }
|
||||
|
||||
|
|
|
@ -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 ;
|
Loading…
Reference in New Issue