extra/models/history/history.factor

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