extra/models/history/history.factor

   1 ! Copyright (C) 2008 Slava Pestov.\r
   2 ! See http://factorcode.org/license.txt for BSD license.\r
   3 USING: accessors kernel locals models sequences ;\r
   4 IN: models.history\r
   5 \r
   6 TUPLE: history < model back forward ;\r
   7 \r
   8 : reset-history ( history -- history )\r
   9     V{ } clone >>back\r
  10     V{ } clone >>forward ; inline\r
  11 \r
  12 : <history> ( value -- history )\r
  13     history new-model\r
  14         reset-history ;\r
  15 \r
  16 : (add-history) ( history to -- )\r
  17     swap value>> [ swap push ] [ drop ] if* ;\r
  18 \r
  19 :: go-back/forward ( history to from -- )\r
  20     from empty? [\r
  21         history to (add-history)\r
  22         from pop history set-model\r
  23     ] unless ;\r
  24 \r
  25 : go-back ( history -- )\r
  26     dup [ forward>> ] [ back>> ] bi go-back/forward ;\r
  27 \r
  28 : go-forward ( history -- )\r
  29     dup [ back>> ] [ forward>> ] bi go-back/forward ;\r
  30 \r
  31 : add-history ( history -- )\r
  32     dup forward>> delete-all\r
  33     dup back>> (add-history) ;\r