basis/models/arrow/arrow.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel models sequences ;
   4 IN: models.arrow
   5
   6 TUPLE: arrow < model quot ;
   7
   8 : new-arrow ( model quot class -- arrow )
   9     f swap new-model
  10     swap >>quot
  11     [ add-dependency ] keep ;
  12
  13 : <arrow> ( model quot -- arrow )
  14     arrow new-arrow ;
  15
  16 : compute-arrow-value ( model observer -- value )
  17     [ value>> ] [ quot>> ] bi* call( old -- new ) ; inline
  18
  19 M: arrow model-changed
  20     [ compute-arrow-value ] [ set-model ] bi ;
  21
  22 M: arrow model-activated
  23     [ dependencies>> ] keep [ model-changed ] curry each ;
  24
  25 TUPLE: ?arrow < arrow ;
  26
  27 : <?arrow> ( model quot -- ?arrow )
  28     ?arrow new-arrow ;
  29
  30 M: ?arrow model-changed
  31     [ compute-arrow-value ] [ ?set-model ] bi ;