1 USING: ui.gadgets ui.gadgets.packs ui.gadgets.worlds tools.test
2 namespaces models kernel accessors ;
3 IN: ui.gadgets.worlds.tests
8 : <test-world> ( gadget -- world )
12 "g1" get <test-world> "w" set
15 [ ] [ "g1" get request-focus ] unit-test
17 [ t ] [ "w" get focus>> "g1" get eq? ] unit-test
21 "g2" get "g1" get add-gadget drop
24 "g2" get <test-world> "w" set
27 [ ] [ "g1" get request-focus ] unit-test
29 [ t ] [ "w" get focus>> "g2" get eq? ] unit-test
30 [ t ] [ "g2" get focus>> "g1" get eq? ] unit-test
31 [ f ] [ "g1" get focus>> ] unit-test
36 "g3" get "g1" get add-gadget drop
37 "g3" get "g2" get add-gadget drop
40 "g3" get <test-world> "w" set
43 [ ] [ "g1" get request-focus ] unit-test
44 [ ] [ "g2" get unparent ] unit-test
45 [ t ] [ "g3" get focus>> "g1" get eq? ] unit-test
47 [ t ] [ <gadget> dup <test-world> focusable-child eq? ] unit-test
49 TUPLE: focusing < gadget ;
51 : <focusing> ( -- gadget ) focusing new ;
53 TUPLE: focus-test < gadget ;
55 : <focus-test> ( -- gadget )
56 focus-test new <focusing> add-gadget ;
58 M: focus-test focusable-child* gadget-child ;
62 [ ] [ "f" get <test-world> request-focus ] unit-test
64 [ t ] [ "f" get focus>> "f" get gadget-child eq? ] unit-test
66 [ t ] [ "f" get gadget-child focusing? ] unit-test