basis/models/compose/compose.factor

   1 ! Copyright (C) 2008 Slava Pestov.\r
   2 ! See http://factorcode.org/license.txt for BSD license.\r
   3 USING: accessors models kernel sequences ;\r
   4 IN: models.compose\r
   5 \r
   6 TUPLE: compose < model ;\r
   7 \r
   8 : new-compose ( models class -- compose )\r
   9     f swap new-model\r
  10         swap clone >>dependencies ; inline\r
  11 \r
  12 : <compose> ( models -- compose )\r
  13     compose new-compose ;\r
  14 \r
  15 : composed-value [ dependencies>> ] dip map ; inline\r
  16 \r
  17 : set-composed-value [ dependencies>> ] dip 2each ; inline\r
  18 \r
  19 M: compose model-changed\r
  20     nip\r
  21     [ [ value>> ] composed-value ] keep set-model ;\r
  22 \r
  23 M: compose model-activated dup model-changed ;\r
  24 \r
  25 M: compose update-model\r
  26     dup value>> swap [ set-model ] set-composed-value ;\r
  27 \r
  28 M: compose range-value\r
  29     [ range-value ] composed-value ;\r
  30 \r
  31 M: compose range-page-value\r
  32     [ range-page-value ] composed-value ;\r
  33 \r
  34 M: compose range-min-value\r
  35     [ range-min-value ] composed-value ;\r
  36 \r
  37 M: compose range-max-value\r
  38     [ range-max-value ] composed-value ;\r
  39 \r
  40 M: compose range-max-value*\r
  41     [ range-max-value* ] composed-value ;\r
  42 \r
  43 M: compose set-range-value\r
  44     [ clamp-value ] keep\r
  45     [ set-range-value ] set-composed-value ;\r
  46 \r
  47 M: compose set-range-page-value\r
  48     [ set-range-page-value ] set-composed-value ;\r
  49 \r
  50 M: compose set-range-min-value\r
  51     [ set-range-min-value ] set-composed-value ;\r
  52 \r
  53 M: compose set-range-max-value\r
  54     [ set-range-max-value ] set-composed-value ;\r