basis/models/arrow/arrow.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov.\r
   2 ! See http://factorcode.org/license.txt for BSD license.\r
   3 USING: accessors models kernel call ;\r
   4 IN: models.arrow\r
   5 \r
   6 TUPLE: arrow < model model quot ;\r
   7 \r
   8 : <arrow> ( model quot -- arrow )\r
   9     f arrow new-model\r
  10         swap >>quot\r
  11         over >>model\r
  12         [ add-dependency ] keep ;\r
  13 \r
  14 M: arrow model-changed\r
  15     [ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi\r
  16     set-model ;\r
  17 \r
  18 M: arrow model-activated [ model>> ] keep model-changed ;\r