diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index fbbf73ebb9..17fdbce401 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -2,10 +2,8 @@ - menu Command: quots look dumb - http://paste.lisp.org/display/30426 -- "ker" C+u: for a moment, full vocab list is shown - some module operations don't work on module-links - list operations: what if nothing is selected? -- modules: core/ libs/ apps/ - top level window positioning on ms windows - crashes: - windows gcc issue @@ -40,6 +38,7 @@ + ui: +- listener: if partial parse, RETURN should insert newline - some way of intercepting all gestures - how do we refer to command shortcuts in the docs? - editor: @@ -51,6 +50,7 @@ + module system: +- modules: core/ libs/ apps/ - track a list of assets loaded from each module's file - C types should be words - TYPEDEF: float { ... } { ... } ; ==> \ float T{ c-type ... } "c-type" swp @@ -87,6 +87,7 @@ + misc: +- automatic help/effects for slot accessors - tuple shape changes - should be possible to reload any source file in library - growable data heap diff --git a/library/ui/models.factor b/library/ui/models.factor index 8696b70094..737bda3a4f 100644 --- a/library/ui/models.factor +++ b/library/ui/models.factor @@ -19,6 +19,10 @@ C: model ( value -- model ) DEFER: add-connection +GENERIC: model-activated ( model -- ) + +M: model model-activated drop ; + : ref-model ( model -- n ) dup model-ref 1+ dup rot set-model-ref ; @@ -28,7 +32,8 @@ DEFER: add-connection : activate-model ( model -- ) dup ref-model 1 = [ dup model-dependencies - [ dup activate-model add-connection ] each-with + [ dup activate-model dupd add-connection ] each + model-activated ] [ drop ] if ; @@ -81,24 +86,26 @@ C: filter ( model quot -- filter ) dup delegate>model [ set-filter-quot ] keep [ set-filter-model ] 2keep - [ add-dependency ] keep - dup model-changed ; + [ add-dependency ] keep ; M: filter model-changed dup filter-model model-value over filter-quot call swap set-model ; +M: filter model-activated model-changed ; + TUPLE: compose ; C: compose ( models -- compose ) dup delegate>model - [ set-model-dependencies ] keep - dup model-changed ; + swap clone over set-model-dependencies ; M: compose model-changed dup model-dependencies [ model-value ] map swap delegate set-model ; +M: compose model-activated model-changed ; + M: compose set-model model-dependencies [ set-model ] 2each ; @@ -129,16 +136,18 @@ C: history ( value -- history ) TUPLE: delay model timeout ; +: update-delay-model ( delay -- ) + dup delay-model model-value swap set-model ; + C: delay ( model timeout -- filter ) dup delegate>model [ set-delay-timeout ] keep [ set-delay-model ] 2keep [ add-dependency ] keep - dup model-changed ; + dup update-delay-model ; -M: delay model-changed - 0 over delay-timeout add-timer ; +M: delay model-changed 0 over delay-timeout add-timer ; -M: delay tick - dup remove-timer - dup delay-model model-value swap set-model ; +M: delay model-activated update-delay-model ; + +M: delay tick dup remove-timer update-delay-model ; diff --git a/library/ui/test/models.factor b/library/ui/test/models.factor index ee861ea51a..07edbad9e3 100644 --- a/library/ui/test/models.factor +++ b/library/ui/test/models.factor @@ -18,7 +18,9 @@ M: model-tester model-changed t swap set-model-tester-hit? ; 4 "model-b" set "model-a" get "model-b" get 2array "model-c" set +"model-c" get activate-model [ { 3 4 } ] [ "model-c" get model-value ] unit-test +"model-c" get deactivate-model T{ model-tester f f } "tester" set @@ -74,3 +76,12 @@ f "history" set [ 9 ] [ "y" get model-value ] unit-test [ ] [ "y" get deactivate-model ] unit-test [ f ] [ "z" get "x" get model-connections memq? ] unit-test + +3 "x" set +"x" get [ sq ] "y" set + +4 "x" get set-model + +"y" get activate-model +[ 16 ] [ "y" get model-value ] unit-test +"y" get deactivate-model