32 lines
812 B
Factor
32 lines
812 B
Factor
! Copyright (C) 2006 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
IN: gadgets
|
|
USING: kernel models ;
|
|
|
|
TUPLE: control self model quot ;
|
|
|
|
C: control ( model gadget quot -- gadget )
|
|
dup dup set-control-self
|
|
[ set-control-quot ] keep
|
|
[ set-gadget-delegate ] keep
|
|
[ set-control-model ] keep ;
|
|
|
|
: control-value ( control -- value ) control-model model-value ;
|
|
|
|
M: control graft*
|
|
control-self dup dup control-model add-connection
|
|
model-changed ;
|
|
|
|
M: control ungraft*
|
|
control-self dup control-model remove-connection ;
|
|
|
|
M: control model-changed
|
|
control-self
|
|
[ control-value ] keep
|
|
[ dup control-quot call ] keep
|
|
relayout ;
|
|
|
|
: delegate>control ( gadget model underlying -- )
|
|
[ 2drop ] <control> over set-gadget-delegate
|
|
dup set-control-self ;
|