|
|
|
|
@ -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: <model>
|
|
|
|
|
{ $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 <filter> } "." } ;
|
|
|
|
|
|
|
|
|
|
HELP: <filter>
|
|
|
|
|
{ $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 <compose> } "." } ;
|
|
|
|
|
|
|
|
|
|
HELP: <compose>
|
|
|
|
|
{ $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 <history> } "." } ;
|
|
|
|
|
|
|
|
|
|
HELP: <history>
|
|
|
|
|
{ $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 <delay> } "." } ;
|
|
|
|
|
|
|
|
|
|
HELP: <delay>
|
|
|
|
|
{ $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." } ;
|
slava