Titled gadget fix and unit tests

slava 2006-10-26 04:07:18 +00:00
parent 0081e1d9bc
commit 7ce12846cb
4 changed files with 13 additions and 5 deletions

View File

@ -64,4 +64,5 @@ PROVIDE: library/ui
"test/search.factor"
"test/sliders.factor"
"test/tracks.factor"
"test/titled-gadget.factor"
} } ;

View File

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

View File

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

View File

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