2 USING: arrays generic kernel math models namespaces sequences
5 TUPLE: model-tester hit? ;
7 : <model-tester> model-tester construct-empty ;
9 M: model-tester model-changed t swap set-model-tester-hit? ;
11 [ T{ model-tester f t } ]
13 T{ model-tester f f } 3 <model> 2dup add-connection
17 3 <model> "model-a" set
18 4 <model> "model-b" set
19 "model-a" get "model-b" get 2array <compose> "model-c" set
21 "model-c" get activate-model
22 [ { 3 4 } ] [ "model-c" get model-value ] unit-test
23 "model-c" get deactivate-model
25 T{ model-tester f f } "tester" set
27 [ T{ model-tester f t } { 6 4 } ]
29 "tester" get "model-c" get add-connection
30 6 "model-a" get set-model
32 "model-c" get model-value
35 f <history> "history" set
37 "history" get add-history
39 [ t ] [ "history" get history-back empty? ] unit-test
40 [ t ] [ "history" get history-forward empty? ] unit-test
42 "history" get add-history
43 3 "history" get set-model
45 [ t ] [ "history" get history-back empty? ] unit-test
46 [ t ] [ "history" get history-forward empty? ] unit-test
48 "history" get add-history
49 4 "history" get set-model
51 [ f ] [ "history" get history-back empty? ] unit-test
52 [ t ] [ "history" get history-forward empty? ] unit-test
56 [ 3 ] [ "history" get model-value ] unit-test
58 [ t ] [ "history" get history-back empty? ] unit-test
59 [ f ] [ "history" get history-forward empty? ] unit-test
61 "history" get go-forward
63 [ 4 ] [ "history" get model-value ] unit-test
65 [ f ] [ "history" get history-back empty? ] unit-test
66 [ t ] [ "history" get history-forward empty? ] unit-test
68 ! Test multiple filters
70 "x" get [ 2 * ] <filter> dup "z" set
71 [ 1+ ] <filter> "y" set
72 [ ] [ "y" get activate-model ] unit-test
73 [ t ] [ "z" get "x" get model-connections memq? ] unit-test
74 [ 7 ] [ "y" get model-value ] unit-test
75 [ ] [ 4 "x" get set-model ] unit-test
76 [ 9 ] [ "y" get model-value ] unit-test
77 [ ] [ "y" get deactivate-model ] unit-test
78 [ f ] [ "z" get "x" get model-connections memq? ] unit-test
81 "x" get [ sq ] <filter> "y" set
85 "y" get activate-model
86 [ 16 ] [ "y" get model-value ] unit-test
87 "y" get deactivate-model
93 "a" get "b" get 2array <compose> "c" set
96 [ ] [ "c" get activate-model ] unit-test
98 [ { 1 2 } ] [ "c" get model-value ] unit-test
100 [ ] [ 3 "b" get set-model ] unit-test
102 [ { 1 3 } ] [ "c" get model-value ] unit-test
104 [ ] [ { 4 5 } "c" get set-model ] unit-test
106 [ { 4 5 } ] [ "c" get model-value ] unit-test
108 [ ] [ "c" get deactivate-model ] unit-test