2007-09-20 18:09:08 -04:00
|
|
|
USING: arrays continuations ui.tools.listener ui.tools.walker
|
|
|
|
|
ui.tools.workspace inspector kernel namespaces sequences threads
|
2007-11-23 16:24:57 -05:00
|
|
|
listener tools.test ui ui.gadgets ui.gadgets.worlds
|
2008-02-21 00:13:31 -05:00
|
|
|
ui.gadgets.packs vectors ui.tools tools.walker
|
|
|
|
|
tools.walker.debug tools.test.ui ;
|
2007-09-20 18:09:08 -04:00
|
|
|
IN: temporary
|
|
|
|
|
|
2007-12-26 22:16:14 -05:00
|
|
|
\ <walker> must-infer
|
2007-11-16 03:01:45 -05:00
|
|
|
|
2007-10-05 17:54:02 -04:00
|
|
|
[ ] [ <walker> "walker" set ] unit-test
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2007-11-16 03:01:45 -05:00
|
|
|
"walker" get [
|
|
|
|
|
! Make sure the toolbar buttons don't throw if we're
|
|
|
|
|
! not actually walking.
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2007-11-16 03:01:45 -05:00
|
|
|
[ ] [ "walker" get com-step ] unit-test
|
|
|
|
|
[ ] [ "walker" get com-into ] unit-test
|
|
|
|
|
[ ] [ "walker" get com-out ] unit-test
|
|
|
|
|
[ ] [ "walker" get com-back ] unit-test
|
|
|
|
|
[ ] [ "walker" get com-inspect ] unit-test
|
|
|
|
|
[ ] [ "walker" get reset-walker ] unit-test
|
|
|
|
|
[ ] [ "walker" get com-continue ] unit-test
|
|
|
|
|
] with-grafted-gadget
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
|
: <test-world> ( gadget -- world )
|
|
|
|
|
[ gadget, ] make-pile "Hi" f <world> ;
|
|
|
|
|
|
2007-11-16 03:01:45 -05:00
|
|
|
f <workspace> dup [
|
2007-09-20 18:09:08 -04:00
|
|
|
[ <test-world> 2array 1vector windows set ] keep
|
|
|
|
|
|
|
|
|
|
"ok" off
|
|
|
|
|
|
|
|
|
|
[
|
|
|
|
|
workspace-listener
|
|
|
|
|
listener-gadget-input
|
|
|
|
|
"ok" on
|
2007-12-30 17:14:15 -05:00
|
|
|
stream-read-quot
|
2007-09-20 18:09:08 -04:00
|
|
|
"c" get continue-with
|
|
|
|
|
] in-thread drop
|
|
|
|
|
|
|
|
|
|
[ t ] [ "ok" get ] unit-test
|
|
|
|
|
|
2007-11-16 03:01:45 -05:00
|
|
|
[ ] [ walker get-tool "w" set ] unit-test
|
2007-09-20 18:09:08 -04:00
|
|
|
continuation "c" set
|
2007-11-16 03:01:45 -05:00
|
|
|
|
2007-09-20 18:09:08 -04:00
|
|
|
[ ] [ "c" get "w" get call-tool* ] unit-test
|
|
|
|
|
|
|
|
|
|
[ ] [
|
|
|
|
|
[ "c" set f ] callcc1
|
|
|
|
|
[ "q" set ] [ "w" get com-inspect stop ] if*
|
|
|
|
|
] unit-test
|
2007-11-16 03:01:45 -05:00
|
|
|
|
2007-09-20 18:09:08 -04:00
|
|
|
[ t ] [
|
|
|
|
|
"q" get dup first continuation?
|
|
|
|
|
swap second \ inspect eq? and
|
|
|
|
|
] unit-test
|
2007-11-16 03:01:45 -05:00
|
|
|
] with-grafted-gadget
|
2007-10-07 18:17:14 -04:00
|
|
|
|
|
|
|
|
[
|
2007-11-16 03:01:45 -05:00
|
|
|
f <workspace> dup [
|
|
|
|
|
<test-world> 2array 1vector windows set
|
2007-10-07 18:17:14 -04:00
|
|
|
|
2007-11-16 03:01:45 -05:00
|
|
|
[ ] [
|
|
|
|
|
[ 2 3 break 4 ] quot>cont f swap 2array walker call-tool
|
|
|
|
|
] unit-test
|
2007-10-07 18:17:14 -04:00
|
|
|
|
2007-11-16 03:01:45 -05:00
|
|
|
[ ] [ walker get-tool com-continue ] unit-test
|
2007-10-07 18:17:14 -04:00
|
|
|
|
2007-11-16 03:01:45 -05:00
|
|
|
[ ] [ yield ] unit-test
|
2007-10-07 18:17:14 -04:00
|
|
|
|
2007-11-16 03:01:45 -05:00
|
|
|
[ t ] [ walker get-tool walker-active? ] unit-test
|
2007-10-09 01:31:41 -04:00
|
|
|
|
2007-11-16 03:01:45 -05:00
|
|
|
[ ] [ "walker" get com-continue ] unit-test
|
2007-10-09 01:31:41 -04:00
|
|
|
|
2007-11-16 03:01:45 -05:00
|
|
|
[ ] [ "walker" get com-continue ] unit-test
|
2007-10-09 01:31:41 -04:00
|
|
|
|
2007-11-16 03:01:45 -05:00
|
|
|
[ ] [ "walker" get com-continue ] unit-test
|
|
|
|
|
] with-grafted-gadget
|
2007-10-07 18:17:14 -04:00
|
|
|
] with-scope
|
