-USING: accessors ui.gadgets ui.gadgets.private ui.gadgets.packs
-ui.gadgets.worlds tools.test namespaces models kernel dlists deques
-math sets math.parser ui sequences hashtables assocs io arrays
-prettyprint io.streams.string math.rectangles ui.gadgets.private ;
+USING: accessors ui.gadgets ui.gadgets.packs ui.gadgets.worlds
+tools.test namespaces models kernel dlists deques math
+math.parser ui sequences hashtables assocs io arrays prettyprint
+io.streams.string math.rectangles ui.gadgets.private sets generic ;
IN: ui.gadgets.tests
[ { 300 300 } ]
TUPLE: mock-gadget < gadget graft-called ungraft-called ;
: <mock-gadget> ( -- gadget )
- mock-gadget new-gadget 0 >>graft-called 0 >>ungraft-called ;
+ mock-gadget new 0 >>graft-called 0 >>ungraft-called ;
M: mock-gadget graft*
- [ 1+ ] change-graft-called drop ;
+ [ 1 + ] change-graft-called drop ;
M: mock-gadget ungraft*
- [ 1+ ] change-ungraft-called drop ;
+ [ 1 + ] change-ungraft-called drop ;
! We can't print to output-stream here because that might be a pane
! stream, and our graft-queue rebinding here would be captured
[ { f f } ] [ "g" get graft-state>> ] unit-test
] with-variable
- : add-some-children
+ : add-some-children ( gadget -- gadget )
3 [
<mock-gadget> over <model> >>model
"g" get over add-gadget drop
- swap 1+ number>string set
+ swap 1 + number>string set
] each ;
- : status-flags
+ : status-flags ( -- seq )
{ "g" "1" "2" "3" } [ get graft-state>> ] map prune ;
: notify-combo ( ? ? -- )
{ { f f } { f t } { t f } { t t } } [ notify-combo ] assoc-each
] with-string-writer print
-
-\ <gadget> must-infer
-\ unparent must-infer
-\ add-gadget must-infer
-\ add-gadgets must-infer
-\ clear-gadget must-infer
-
-\ relayout must-infer
-\ relayout-1 must-infer
-\ pref-dim must-infer