basis/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 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>> dup [ swap push ] [ 2drop ] if ;\r
  18 \r
  19 : go-back/forward ( history to from -- )\r
  20     [ 2drop ]\r
  21     [ >r dupd (add-history) r> pop swap set-model ] if-empty ;\r
  22 \r
  23 : go-back ( history -- )\r
  24     dup [ forward>> ] [ back>> ] bi go-back/forward ;\r
  25 \r
  26 : go-forward ( history -- )\r
  27     dup [ back>> ] [ forward>> ] bi go-back/forward ;\r
  28 \r
  29 : add-history ( history -- )\r
  30     dup forward>> delete-all\r
  31     dup back>> (add-history) ;\r