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

Clean up ui.gadgets.lists a tiny bit

db4
Slava Pestov 2009-01-06 15:54:17 -06:00
parent 35dd01de39
commit 5c7af1cf2d
1 changed files with 11 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
basis/ui/gadgets/lists/lists.factor
View File

@ -1,17 +1,17 @@
! Copyright (C) 2006, 2008 Slava Pestov. ! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors ui.commands ui.gestures ui.render ui.gadgets USING: accessors math.vectors classes.tuple math.geometry.rect colors
ui.gadgets.labels ui.gadgets.scrollers
kernel sequences models opengl math math.order namespaces kernel sequences models opengl math math.order namespaces
ui.commands ui.gestures ui.render ui.gadgets
ui.gadgets.labels ui.gadgets.scrollers
ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.packs ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.packs
math.vectors classes.tuple math.geometry.rect colors ; ui.gadgets.theme ;
IN: ui.gadgets.lists IN: ui.gadgets.lists
TUPLE: list < pack index presenter color hook ; TUPLE: list < pack index presenter color hook ;
: list-theme ( list -- list ) : list-theme ( list -- list )
T{ rgba f 0.8 0.8 1.0 1.0 } >>color ; inline selection-color >>color ; inline
: <list> ( hook presenter model -- gadget ) : <list> ( hook presenter model -- gadget )
list new-gadget list new-gadget
@ -81,23 +81,21 @@ M: list focusable-child* drop t ;
dup list-empty? [ dup list-empty? [
2drop 2drop
] [ ] [
[ control-value length rem ] keep tuck control-value length rem >>index
swap >>index [ relayout-1 ] [ scroll>selected ] bi
dup relayout-1
scroll>selected
] if ; ] if ;
: select-previous ( list -- ) : select-previous ( list -- )
dup index>> 1- swap select-index ; [ index>> 1- ] keep select-index ;
: select-next ( list -- ) : select-next ( list -- )
dup index>> 1+ swap select-index ; [ index>> 1+ ] keep select-index ;
: invoke-value-action ( list -- ) : invoke-value-action ( list -- )
dup list-empty? [ dup list-empty? [
dup hook>> call dup hook>> call
] [ ] [
dup index>> swap nth-gadget invoke-secondary [ index>> ] keep nth-gadget invoke-secondary
] if ; ] if ;
: select-gadget ( gadget list -- ) : select-gadget ( gadget list -- )