ui.gadgets.tables: some performance improvements.

db4
John Benediktsson 2012-09-20 08:34:43 -07:00
parent a025d81798
commit 88b196dc8c
3 changed files with 46 additions and 13 deletions

View File

@ -9,19 +9,39 @@ IN: ui.gadgets.line-support
TUPLE: line-gadget < gadget
font selection-color
min-rows max-rows
min-cols max-cols ;
min-cols max-cols
line-leading line-height
pref-viewport-dim ;
: new-line-gadget ( class -- gadget )
new
selection-color >>selection-color ;
GENERIC: line-leading* ( gadget -- n )
M: line-gadget line-leading* font>> font-metrics leading>> ;
GENERIC: line-leading ( gadget -- n )
M: line-gadget line-leading font>> font-metrics leading>> ;
M: line-gadget line-leading
dup line-leading>>
[ ] [
[ line-leading* ] [ ] [ layout-state>> ] tri
[ drop ] [ dupd line-leading<< ] if
] ?if ;
GENERIC: line-height* ( gadget -- n )
M: line-gadget line-height* font>> font-metrics height>> ceiling ;
GENERIC: line-height ( gadget -- n )
M: line-gadget line-height font>> font-metrics height>> ceiling ;
M: line-gadget line-height
dup line-height>>
[ ] [
[ line-height* ] [ ] [ layout-state>> ] tri
[ drop ] [ dupd line-height<< ] if
] ?if ;
: y>line ( y gadget -- n ) line-height /i ;
@ -78,11 +98,18 @@ PRIVATE>
: line-gadget-height ( pref-dim gadget -- h )
[ second ] [ [ line-height ] [ min-rows>> ] [ max-rows>> ] tri ] bi* clamp ;
M: line-gadget pref-viewport-dim
: pref-viewport-dim* ( gadget -- dim )
[ pref-dim ] [ ] bi
[ line-gadget-width ]
[ line-gadget-height ]
2bi 2array ;
2bi 2array ; inline
M: line-gadget pref-viewport-dim
dup pref-viewport-dim>>
[ ] [
[ pref-viewport-dim* ] [ ] [ layout-state>> ] tri
[ drop ] [ dupd pref-viewport-dim<< ] if
] ?if ;
: visible-lines ( gadget -- n )
[ visible-dim second ] [ line-height ] bi /i ;

View File

@ -49,7 +49,8 @@ selection-index
selection
mouse-index
{ takes-focus? initial: t }
focused? ;
focused?
rows ;
: new-table ( rows renderer class -- table )
new-line-gadget
@ -88,6 +89,9 @@ M: image-name draw-cell nip draw-image ;
: table-rows ( table -- rows )
[ control-value ] [ renderer>> ] bi '[ _ row-columns ] map ;
: update-table-rows ( table -- )
[ table-rows ] [ rows<< ] bi ; inline
: column-offsets ( widths gap -- x xs )
[ 0 ] dip '[ _ + + ] accumulate ;
@ -109,7 +113,7 @@ CONSTANT: column-title-background COLOR: light-gray
swap [ column-offsets drop ] keep - ;
: compute-column-widths ( table -- total widths )
dup table-rows [ drop 0 { } ] [
dup rows>> [ drop 0 { } ] [
[ drop gap>> ] [ initial-widths ] [ ] 2tri
[ row-column-widths vmax ] with each
[ compute-total-width ] keep
@ -131,7 +135,9 @@ CONSTANT: column-title-background COLOR: light-gray
[ [ + ] change-nth ] [ 3drop ] if ;
M: table layout*
[ update-cached-widths ] [ update-filled-column ] bi ;
[ update-table-rows ]
[ update-cached-widths ]
[ update-filled-column ] tri ;
: row-rect ( table row -- rect )
[ [ line-height ] dip * 0 swap 2array ]
@ -225,7 +231,7 @@ M: table draw-gadget*
] with-variable
] if ;
M: table line-height ( table -- y )
M: table line-height* ( table -- y )
[ font>> ] [ renderer>> prototype-row ] bi
[ [ cell-height ] [ cell-padding ] bi + ] with
[ max ] map-reduce ;
@ -349,7 +355,7 @@ PRIVATE>
: prev/next-row ( table n -- )
[ dup selection-index>> value>> ] dip
'[ _ + ] [ 0 ] if* select-row ;
: previous-row ( table -- )
-1 prev/next-row ;

View File

@ -12,14 +12,14 @@ tool-dims [ H{ } clone ] initialize
TUPLE: tool < track ;
M: tool pref-dim*
{ [ class-of tool-dims get at ] [ call-next-method ] } 1|| ;
{ [ class-of tool-dims get-global at ] [ call-next-method ] } 1|| ;
M: tool layout*
[ call-next-method ]
[ [ dim>> ] [ class-of ] bi tool-dims get set-at ]
[ [ dim>> ] [ class-of ] bi tool-dims get-global set-at ]
bi ;
: set-tool-dim ( dim class -- ) tool-dims get set-at ;
: set-tool-dim ( dim class -- ) tool-dims get-global set-at ;
SLOT: scroller