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