extra/models/illusion/illusion.factor

   1 USING: accessors inverse kernel models models.arrow ;
   2 IN: models.illusion
   3
   4 TUPLE: illusion < arrow ;
   5
   6 : <illusion> ( model quot -- illusion )
   7     f illusion new-model
   8         swap >>quot
   9         over >>model
  10     [ add-dependency ] keep ;
  11
  12 : <activated-illusion> ( model quot -- illusion )
  13     <illusion> dup activate-model ;
  14
  15 : backtalk ( value object -- )
  16    [ quot>> [undo] call( a -- b ) ] [ model>> ] bi set-model ;
  17
  18 M: illusion update-model ( model -- )
  19     [ [ value>> ] keep backtalk ] with-locked-model ;