steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix UI pane selection

db4
Slava Pestov 2009-04-02 09:09:09 -05:00
parent 0db52b0545
commit 4f19f9b2c1
4 changed files with 88 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
basis/ui/gadgets/gadgets.factor
View File

@ -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 ;

34
basis/ui/gadgets/panes/panes.factor
View File

@ -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 ;

101
basis/ui/render/render.factor
View File

@ -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 }

14
basis/ui/traverse/traverse.factor
View File

@ -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 ;