models: some more cleanup.

diff --git a/basis/models/arrow/arrow.factor b/basis/models/arrow/arrow.factor
index a1654ccc347596c001e7f86d226a6aab0ca50389..2ed0e9fea0fc68d1bf2cf0cd09235fc79f7bac27 100644 (file)
--- a/basis/models/arrow/arrow.factor
+++ b/basis/models/arrow/arrow.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
-USING: accessors models kernel sequences ;\r
+USING: accessors kernel models sequences ;\r
 IN: models.arrow\r
 \r
 TUPLE: arrow < model quot ;\r
@@ -8,11 +8,11 @@ TUPLE: arrow < model quot ;
 : <arrow> ( model quot -- arrow )\r
     f arrow new-model\r
         swap >>quot\r
-        [ add-dependency ] keep ;\r
+    [ add-dependency ] keep ;\r
 \r
 M: arrow model-changed\r
-    [ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi\r
-    set-model ;\r
+    [ [ value>> ] [ quot>> ] bi* call( old -- new ) ]\r
+    [ set-model ] bi ;\r
 \r
 M: arrow model-activated\r
     [ dependencies>> ] keep [ model-changed ] curry each ;\r

diff --git a/basis/models/product/product.factor b/basis/models/product/product.factor
index efce437ffdb40223a7de930c5c20996b1dcd52c4..04e06cb55abdfdfd12b3c975224a3eac78ff1f25 100644 (file)
--- a/basis/models/product/product.factor
+++ b/basis/models/product/product.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
-USING: accessors models kernel sequences ;\r
+USING: accessors kernel models sequences ;\r
 IN: models.product\r
 \r
 TUPLE: product < model ;\r
@@ -26,7 +26,7 @@ M: product model-changed
 M: product model-activated dup model-changed ;\r
 \r
 M: product update-model\r
-    dup value>> swap [ set-model ] set-product-value ;\r
+    [ value>> ] keep [ set-model ] set-product-value ;\r
 \r
 M: product range-value\r
     [ range-value ] product-value ;\r

diff --git a/extra/models/history/history.factor b/extra/models/history/history.factor
index 90d6b594ffdfb62276545bea0ff8ef1fe8267230..58cd6e0bca033ed0660e06ba4c9474e119035588 100644 (file)
--- a/extra/models/history/history.factor
+++ b/extra/models/history/history.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
-USING: accessors kernel models sequences ;\r
+USING: accessors kernel locals models sequences ;\r
 IN: models.history\r
 \r
 TUPLE: history < model back forward ;\r
@@ -14,11 +14,13 @@ TUPLE: history < model back forward ;
         reset-history ;\r
 \r
 : (add-history) ( history to -- )\r
-    swap value>> dup [ swap push ] [ 2drop ] if ;\r
+    swap value>> [ swap push ] [ drop ] if* ;\r
 \r
-: go-back/forward ( history to from -- )\r
-    [ 2drop ]\r
-    [ [ dupd (add-history) ] dip pop swap set-model ] if-empty ;\r
+:: go-back/forward ( history to from -- )\r
+    from empty? [\r
+        history to (add-history)\r
+        from pop history set-model\r
+    ] unless ;\r
 \r
 : go-back ( history -- )\r
     dup [ forward>> ] [ back>> ] bi go-back/forward ;\r

diff --git a/extra/models/illusion/illusion.factor b/extra/models/illusion/illusion.factor
index 00169792a9a36966585e7b6820f6fb1b71a33082..27cee7d13b6f5800ff4b1c6d241f29d5361cf64f 100644 (file)
--- a/extra/models/illusion/illusion.factor
+++ b/extra/models/illusion/illusion.factor
@@ -1,15 +1,19 @@
-USING: accessors models models.arrow inverse kernel ;
+USING: accessors inverse kernel models models.arrow ;
 IN: models.illusion
 
 TUPLE: illusion < arrow ;
 
 : <illusion> ( model quot -- illusion )
-    illusion new V{ } clone >>connections V{ } clone >>dependencies 0 >>ref
-    swap >>quot over >>model [ add-dependency ] keep ;
+    f illusion new-model
+        swap >>quot
+        over >>model
+    [ add-dependency ] keep ;
 
-: <activated-illusion> ( model quot -- illusion ) <illusion> dup activate-model ;
+: <activated-illusion> ( model quot -- illusion )
+    <illusion> dup activate-model ;
 
 : backtalk ( value object -- )
    [ quot>> [undo] call( a -- b ) ] [ model>> ] bi set-model ;
 
-M: illusion update-model ( model -- ) [ [ value>> ] keep backtalk ] with-locked-model ;
\ No newline at end of file
+M: illusion update-model ( model -- )
+    [ [ value>> ] keep backtalk ] with-locked-model ;