37 lines
925 B
Factor
37 lines
925 B
Factor
|
! Copyright (C) 2006 Slava Pestov.
|
||
|
|
! See http://factorcode.org/license.txt for BSD license.
|
||
|
|
USING: kernel models ;
|
||
|
IN: gadgets
|
||
|
|
|
||
|
|
TUPLE: control self model quot ;
|
||
|
|
|
||
|
|
: (delegate>control) ( tuple gadget -- )
|
||
|
|
over set-gadget-delegate dup set-control-self ;
|
||
|
|
|
||
|
|
C: control ( model gadget quot -- gadget )
|
||
|
|
[ set-control-quot ] keep
|
||
|
|
[ swap (delegate>control) ] keep
|
||
|
|
[ set-control-model ] keep ;
|
||
|
|
|
||
|
|
: control-value ( control -- value )
|
||
|
|
control-model model-value ;
|
||
|
|
|
||
|
|
: set-control-value ( value control -- )
|
||
|
|
control-model set-model ;
|
||
|
|
|
||
|
|
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 ( tuple model underlying -- )
|
||
|
|
[ 2drop ] <control> (delegate>control) ;
|