basis/models/product/product.factor

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