basis/models/range/range.factor

   1 ! Copyright (C) 2008 Slava Pestov.\r
   2 ! See http://factorcode.org/license.txt for BSD license.\r
   3 USING: accessors kernel models arrays sequences math math.order\r
   4 models.product ;\r
   5 FROM: models.product => product ;\r
   6 IN: models.range\r
   7 \r
   8 TUPLE: range < product ;\r
   9 \r
  10 : <range> ( value page min max -- range )\r
  11     4array [ <model> ] map range new-product ;\r
  12 \r
  13 : range-model ( range -- model ) dependencies>> first ;\r
  14 : range-page ( range -- model ) dependencies>> second ;\r
  15 : range-min ( range -- model ) dependencies>> third ;\r
  16 : range-max ( range -- model ) dependencies>> fourth ;\r
  17 \r
  18 M: range range-value\r
  19     [ range-model value>> ] keep clamp-value ;\r
  20 \r
  21 M: range range-page-value range-page value>> ;\r
  22 \r
  23 M: range range-min-value range-min value>> ;\r
  24 \r
  25 M: range range-max-value range-max value>> ;\r
  26 \r
  27 M: range range-max-value*\r
  28     [ range-max-value ] [ range-page-value ] bi [-] ;\r
  29 \r
  30 M: range set-range-value\r
  31     [ clamp-value ] [ range-model ] bi set-model ;\r
  32 \r
  33 M: range set-range-page-value range-page set-model ;\r
  34 \r
  35 M: range set-range-min-value range-min set-model ;\r
  36 \r
  37 M: range set-range-max-value range-max set-model ;\r
  38 \r
  39 : move-by ( amount range -- )\r
  40     [ range-value + ] keep set-range-value ;\r
  41 \r
  42 : move-by-page ( amount range -- )\r
  43     [ range-page-value * ] keep move-by ;\r