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     dup [ value>> ] composed-value >>value\r
  22     notify-connections ;\r
  23 \r
  24 M: compose model-activated dup model-changed ;\r
  25 \r
  26 M: compose update-model\r
  27     dup value>> swap [ set-model ] set-composed-value ;\r
  28 \r
  29 M: compose range-value\r
  30     [ range-value ] composed-value ;\r
  31 \r
  32 M: compose range-page-value\r
  33     [ range-page-value ] composed-value ;\r
  34 \r
  35 M: compose range-min-value\r
  36     [ range-min-value ] composed-value ;\r
  37 \r
  38 M: compose range-max-value\r
  39     [ range-max-value ] composed-value ;\r
  40 \r
  41 M: compose range-max-value*\r
  42     [ range-max-value* ] composed-value ;\r
  43 \r
  44 M: compose set-range-value\r
  45     [ clamp-value ] keep\r
  46     [ set-range-value ] set-composed-value ;\r
  47 \r
  48 M: compose set-range-page-value\r
  49     [ set-range-page-value ] set-composed-value ;\r
  50 \r
  51 M: compose set-range-min-value\r
  52     [ set-range-min-value ] set-composed-value ;\r
  53 \r
  54 M: compose set-range-max-value\r
  55     [ set-range-max-value ] set-composed-value ;\r