Titled gadget fix and unit tests
parent
0081e1d9bc
commit
7ce12846cb
|
@ -64,4 +64,5 @@ PROVIDE: library/ui
|
|||
"test/search.factor"
|
||||
"test/sliders.factor"
|
||||
"test/tracks.factor"
|
||||
"test/titled-gadget.factor"
|
||||
} } ;
|
||||
|
|
|
@ -1,9 +1,9 @@
|
|||
IN: temporary
|
||||
USING: gadgets-panes gadgets freetype namespaces kernel
|
||||
USING: alien gadgets-panes gadgets freetype namespaces kernel
|
||||
sequences io test prettyprint ;
|
||||
|
||||
: maybe-with-freetype
|
||||
freetype get [ call ] [ with-freetype ] if ; inline
|
||||
freetype get expired? [ with-freetype ] [ call ] if ; inline
|
||||
|
||||
: #children "pane" get gadget-children length ;
|
||||
|
||||
|
|
|
@ -0,0 +1,7 @@
|
|||
IN: temporary
|
||||
USING: gadgets-labels gadgets namespaces test ;
|
||||
|
||||
"Hey" <label> "Foo" <titled-gadget> "t" set
|
||||
|
||||
[ t ] [ "t" get focusable-child label? ] unit-test
|
||||
[ "Foo" ] [ "t" get gadget-title ] unit-test
|
|
@ -57,15 +57,15 @@ SYMBOL: windows
|
|||
10 sleep
|
||||
] assert-depth ;
|
||||
|
||||
TUPLE: titled-gadget title ;
|
||||
TUPLE: titled-gadget title child ;
|
||||
|
||||
M: titled-gadget gadget-title titled-gadget-title ;
|
||||
|
||||
M: titled-gadget focusable-child* gadget-child ;
|
||||
M: titled-gadget focusable-child* titled-gadget-child ;
|
||||
|
||||
C: titled-gadget ( gadget title -- )
|
||||
[ set-titled-gadget-title ] keep
|
||||
{ { f f f @center } } make-frame* ;
|
||||
{ { f set-titled-gadget-child f @center } } make-frame* ;
|
||||
|
||||
: open-window ( world -- )
|
||||
dup pref-dim over set-gadget-dim
|
||||
|
|
Loading…
Reference in New Issue