diff --git a/TODO.txt b/TODO.txt index 108f790435..5b0ead8b21 100644 --- a/TODO.txt +++ b/TODO.txt @@ -5,6 +5,7 @@ - browser: tile titles should respond to right-clicks and/or have a menu popup button - ui docs +- calling 'see' with an unknown method should be an error + 0.88: diff --git a/core/ui/gadgets.facts b/core/ui/gadgets.facts index 49a758b1de..67823ad63d 100644 --- a/core/ui/gadgets.facts +++ b/core/ui/gadgets.facts @@ -91,6 +91,7 @@ HELP: HELP: delegate>gadget { $values { "tuple" tuple } } { $description "Sets the tuple's delegate to a new " { $link gadget } "." } +{ $side-effects "tuple" } { $see-also } ; HELP: relative-loc diff --git a/core/ui/layouts.facts b/core/ui/layouts.facts index 4104f86fb2..7a44ebaa97 100644 --- a/core/ui/layouts.facts +++ b/core/ui/layouts.facts @@ -83,6 +83,7 @@ HELP: HELP: delegate>pack { $values { "orientation" "either " { $snippet "{ 1 0 }" } " or " { $snippet "{ 0 1 }" } } { "tuple" tuple } } { $description "Sets the tuple's delegate to a new pack." } +{ $side-effects "tuple" } { $see-also } ; HELP: diff --git a/core/ui/load.factor b/core/ui/load.factor index 9797c37bdf..06f37cf9df 100644 --- a/core/ui/load.factor +++ b/core/ui/load.factor @@ -49,8 +49,10 @@ PROVIDE: core/ui "gestures.facts" "hierarchy.facts" "layouts.facts" + "models.facts" "paint.facts" "text.facts" + "timers.facts" "world.facts" "windows.facts" "text/editor.facts" diff --git a/core/ui/models.factor b/core/ui/models.factor index 0d0fc7c787..330f088062 100644 --- a/core/ui/models.factor +++ b/core/ui/models.factor @@ -3,7 +3,7 @@ IN: models USING: generic kernel math sequences timers ; -TUPLE: model connections value dependencies ref ; +TUPLE: model value connections dependencies ref ; C: model ( value -- model ) [ set-model-value ] keep @@ -11,10 +11,12 @@ C: model ( value -- model ) V{ } clone over set-model-dependencies 0 over set-model-ref ; -: add-dependency ( model model -- ) +M: model equal? eq? ; + +: add-dependency ( dep model -- ) model-dependencies push ; -: remove-dependency ( model model -- ) +: remove-dependency ( dep model -- ) model-dependencies delete ; DEFER: add-connection @@ -50,11 +52,11 @@ DEFER: remove-connection GENERIC: model-changed ( observer -- ) -: add-connection ( obj model -- ) +: add-connection ( observer model -- ) dup model-connections empty? [ dup activate-model ] when model-connections push ; -: remove-connection ( obj model -- ) +: remove-connection ( observer model -- ) [ model-connections delete ] keep dup model-connections empty? [ dup deactivate-model ] when drop ; @@ -74,7 +76,7 @@ M: model set-model : (change-model) ( model quot -- ) ((change-model)) set-model-value ; inline -: delegate>model ( obj -- ) +: delegate>model ( tuple -- ) f swap set-delegate ; TUPLE: filter model quot ; @@ -127,7 +129,7 @@ C: history ( value -- history ) : go-forward ( history -- ) dup history-back over history-forward go-back/forward ; -: add-history +: add-history ( history -- ) dup history-forward delete-all dup history-back (add-history) ; diff --git a/core/ui/models.facts b/core/ui/models.facts new file mode 100644 index 0000000000..efcb2053eb --- /dev/null +++ b/core/ui/models.facts @@ -0,0 +1,130 @@ +IN: models +USING: help generic kernel ; + +HELP: model +{ $class-description "A mutable placeholder for a single value. When the value is changed, a sequence of connected objects are notified. Models have the following slots:" + { $list + { { $link model-value } " - the value of the model. Use " { $link set-model } " to change the value." } + { { $link model-connections } " - a sequence of objects implementing the " { $link model-changed } " generic word, to be notified when the model's value changes." } + { { $link model-dependencies } " - a sequence of models which should have this model added to their sequence of connections when activated." } + { { $link model-ref } " - a reference count tracking the number of models which depend on this one." } + } +"Other classes may delegate to " { $link model } "." +} ; + +HELP: +{ $values { "value" object } { "model" "a new " { $link model } } } +{ $description "Creates a new model with an initial value." } ; + +HELP: add-dependency +{ $values { "dep" model } { "model" model } } +{ $description "Registers a dependency. When " { $snippet "model" } " is activated, it will be added to " { $snippet "dep" } "'s connections and notified when " { $snippet "dep" } " changes." } +{ $notes "This word should not be called directly unless you are implementing your own model class." } +{ $see-also remove-dependency activate-model deactivate-model } ; + +HELP: remove-dependency +{ $values { "dep" model } { "model" model } } +{ $description "Unregisters a dependency." } +{ $notes "This word should not be called directly unless you are implementing your own model class." } +{ $see-also add-dependency activate-model deactivate-model } ; + +HELP: model-activated +{ $values { "model" model } } +{ $contract "Called after a model has been activated." } +{ $see-also activate-model deactivate-model } ; + +HELP: activate-model +{ $values { "model" model } } +{ $description "Increments the reference count of the model. If it was previously zero, this model is added as a connection to all models registered as dependencies by " { $link add-dependency } "." } +{ $warning "Calls to " { $link activate-model } " and " { $link deactivate-model } " should be balanced to keep the reference counting consistent, otherwise " { $link model-changed } " might be called at the wrong time or not at all." } ; + +HELP: deactivate-model +{ $values { "model" model } } +{ $description "Decrements the reference count of the model. If it reaches zero, this model is removed as a connection from all models registered as dependencies by " { $link add-dependency } "." } +{ $warning "Calls to " { $link activate-model } " and " { $link deactivate-model } " should be balanced to keep the reference counting consistent, otherwise " { $link model-changed } " might be called at the wrong time or not at all." } ; + +HELP: model-changed +{ $values { "observer" object } } +{ $contract "Called to notify observers of a model that the model value has changed as a result of a call to " { $link set-model } ". Observers can be registered with " { $link add-connection } "." } +{ $see-also remove-connection } ; + +HELP: add-connection +{ $values { "observer" object } { "model" model } } +{ $contract "Registers an object interested in being notified of changes to the model's value. When the value is changed as a result of a call to " { $link set-model } ", the " { $link model-changed } " word is called on the observer." } +{ $see-also remove-connection add-dependency } ; + +HELP: remove-connection +{ $values { "observer" object } { "model" model } } +{ $contract "Unregisters an object no longer interested in being notified of changes to the model's value." } +{ $see-also add-connection remove-dependency } ; + +HELP: set-model +{ $values { "value" object } { "model" model } } +{ $description "Changes the value of a model and calls " { $link model-changed } " on all observers registered with " { $link add-connection } "." } +{ $see-also change-model } ; + +HELP: set-model-value ( value model -- ) +{ $values { "value" object } { "model" model } } +{ $description "Changes the value of a model without notifying any observers registered with " { $link add-connection } "." } +{ $notes "There are very few reasons for user code to call this word. Instead, call " { $link set-model } ", which notifies observers." } +{ $see-also change-model } ; + +HELP: change-model +{ $values { "model" model } { "quot" "a quotation with stack effect " { $snippet "( obj -- newobj )" } } } +{ $description "Applies the quotation to the current value of the model to yield a new value, then changes the value of the model to the new value, and calls " { $link model-changed } " on all observers registered with " { $link add-connection } "." } +{ $see-also set-model } ; + +HELP: (change-model) +{ $values { "model" model } { "quot" "a quotation with stack effect " { $snippet "( obj -- newobj )" } } } +{ $description "Applies the quotation to the current value of the model to yield a new value, then changes the value of the model to the new value without notifying any observers registered with " { $link add-connection } "." } +{ $notes "There are very few reasons for user code to call this word. Instead, call " { $link change-model } ", which notifies observers." } +{ $see-also set-model } ; + +HELP: delegate>model +{ $values { "tuple" tuple } } +{ $description + "Sets the tuple's delegate to a new " { $link model } " with an initial value of " { $link f } "." +} ; + +HELP: filter +{ $class-description "Filter model values are computed by applying a quotation to the value of another model. Filters are automatically updated when the underlying model changes. Filters are constructed by " { $link } "." } ; + +HELP: +{ $values { "model" model } { "quot" "a quotation with stack effect " { $snippet "( obj -- newobj )" } } { "filter" "a new " { $link filter } } } +{ $description "Creates a new instance of " { $link filter } ". The value of the new filter model is computed by applying the quotation to the value." } ; + +HELP: compose +{ $class-description "Compose model values are computed by collecting the values from a sequence of underlying models into a new sequence. Compose models are automatically updated when underlying models change. Compose models are constructed by " { $link } "." } ; + +HELP: +{ $values { "models" "a sequence of models" } { "compose" "a new " { $link compose } } } +{ $description "Creates a new instance of " { $link compose } ". The value of the new compose model is obtained by mapping " { $link model-value } " over the given sequence of models." } ; + +HELP: history +{ $class-description "History models record a timeline of previous values on calls to " { $link add-history } ", and can travel back and forth on the timeline with " { $link go-back } " and " { $link go-forward } ". History models are constructed by " { $link } "." } ; + +HELP: +{ $values { "value" object } { "history" "a new " { $link history } } } +{ $description "Creates a new history model with an initial value." } +{ $see-also add-history go-back go-forward } ; + +HELP: go-back +{ $values { "history" history } } +{ $description "Restores the previous value and calls " { $link model-changed } " on all observers registered with " { $link add-connection } "." } +{ $see-also add-history go-forward } ; + +HELP: go-forward +{ $values { "history" history } } +{ $description "Restores the value set prior to the last call to " { $link go-back } " and calls " { $link model-changed } " on all observers registered with " { $link add-connection } "." } +{ $see-also add-history go-back } ; + +HELP: add-history +{ $values { "history" history } } +{ $description "Adds the current value to the history." } ; + +HELP: delay +{ $class-description "Delay models have the same value as their underlying model, however the value only changes after a timer expires. If the underlying model's value changes again before the timer expires, the timer restarts. Delay models are constructed by " { $link } "." } ; + +HELP: +{ $values { "model" model } { "timeout" "a positive integer" } { "delay" delay } } +{ $description "Creates a new instance of " { $link delay } ". A timer of " { $snippet "timeout" } " milliseconds must elapse from the time the underlying model last changed to when the delay model value is changed and its connections are notified." } ; diff --git a/core/ui/timers.facts b/core/ui/timers.facts new file mode 100644 index 0000000000..643e6f2d32 --- /dev/null +++ b/core/ui/timers.facts @@ -0,0 +1,22 @@ +IN: timers +USING: generic help ; + +HELP: tick +{ $values { "object" object } } +{ $description "Called to notify an object registered with a timer that the timer has fired." } +{ $see-also add-timer remove-timer do-timers } ; + +HELP: add-timer +{ $values { "object" object } { "delay" "a positive integer" } { "initial" "a positive integer" } } +{ $description "Registers a timer. Every " { $snippet "delay" } " milliseconds, " { $link tick } " will be called on the object. The initial delay from the time " { $link add-timer } " is called to when " { $link tick } " is first called is " { $snippet "initial" } " milliseconds." } +{ $see-also remove-timer do-timers } ; + +HELP: remove-timer +{ $values { "object" object } } +{ $description "Unregisters a timer." } +{ $see-also add-timer do-timers } ; + +HELP: do-timers +{ $description "Fires all registered timers which are due to fire." } +{ $notes "This word is automatically called from the UI event loop, however it should be called manually if timers are being used outside of the UI." } +{ $see-also tick add-timer remove-timer } ;