sudokus: some formatting to understand code

diff --git a/extra/models/combinators/combinators.factor b/extra/models/combinators/combinators.factor
index 3ff4d98fee7d279195c7989981acd01ac73f9d64..db2f3558a85373d1bc1c23c646fef16b3c43905d 100644 (file)
--- a/extra/models/combinators/combinators.factor
+++ b/extra/models/combinators/combinators.factor
@@ -108,7 +108,7 @@ M: (when-model) (model-changed) [ quot>> ] 2keep
     [ value>> ] [ cond>> ] bi* call( a -- ? ) [ call( model -- ) ] [ 2drop ] if ;
 
 ! only used in construction
-: with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
+: with-self ( quot -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
 
 USE: models.combinators.templates
 << { "$>" "<$" "fmap" } [ fmaps ] each >>

diff --git a/extra/sudokus/sudokus.factor b/extra/sudokus/sudokus.factor
index d4110d4f80f900a6675eebf53f7917b155354f84..c0f714e0e9ee67628872aab5aad2ff46de3fa6b6 100644 (file)
--- a/extra/sudokus/sudokus.factor
+++ b/extra/sudokus/sudokus.factor
@@ -12,10 +12,13 @@ IN: sudokus
 : nth-or-lower ( n seq -- elt ) [ length 1 - 2dup > [ nip ] [ drop ] if ] keep nth ;
 
 :: solutions ( puzzle random? -- solutions )
-    f puzzle random? [ indices [ f ] [ random? swap nth-or-lower ] if-empty ] [ index ] if
-    [ :> pos
-      1 9 [a..b] 80 <iota> [ pos near ] filter [ puzzle nth ] map members diff
-      [ 1array puzzle pos cut-slice rest surround ] map >list [ random? solutions ] bind
+    f puzzle random? [
+        indices [ f ] [ random? swap nth-or-lower ] if-empty
+    ] [ index ] if [| pos |
+        1 9 [a..b] 80 <iota> [ pos near ] filter
+        [ puzzle nth ] map members diff
+        [ 1array puzzle pos cut-slice rest surround ] map >list
+        [ random? solutions ] bind
     ] [ puzzle list-monad return ] if* ;
 
 : solution ( puzzle random? -- solution )
@@ -33,22 +36,31 @@ IN: sudokus
         [ f swap [ length random ] keep set-nth ] curry times
     ] keep ;
 
-: do-sudoku ( -- )
+: <sudoku-gadget> ( -- gadget )
     [
         [
-            [
-                81 [ "" ] replicate <basic> switch-models [ [ <basic> ] map 9 group [ 3 group ] map 3 group
-                   [ [ [ <spacer> [ [ <model-field> ->% 2 [ string>number ] fmap ]
-                        map <spacer> ] map concat ] <hbox> , ] map concat <spacer> ] map concat <product>
-                   [ "Difficulty:" <label> , "1" <basic> <model-field> -> [ string>number 1 or 1 + 10 * ] fmap
-                   "Generate" <model-border-btn> -> updates [ create ] fmap <spacer>
-                   "Hint" <model-border-btn> -> "Solve" <model-border-btn> -> ] <hbox> ,
-                   roll [ swap updates ] curry bi@
-                   [ [ hint ] fmap ] [ [ f solution ] fmap ] bi* 3array merge [ [ [ number>string ] [ "" ] if* ] map ] fmap
-               ] bind
-            ] with-self ,
-        ] <vbox> { 280 220 } >>pref-dim
-        "Sudoku Sleuth" open-window
-    ] with-ui ;
+            81 [ "" ] replicate <basic> switch-models [
+                [ <basic> ] map 9 group [ 3 group ] map 3 group
+                [
+                    [
+                        [
+                            <spacer> [
+                                [ <model-field> ->% 2 [ string>number ] fmap ] map <spacer>
+                            ] map concat
+                        ] <hbox> ,
+                    ] map concat <spacer>
+                ] map concat <product>
+                [
+                    "Difficulty:" <label> , "1" <basic> <model-field> -> [ string>number 1 or 1 + 10 * ] fmap
+                    "Generate" <model-border-btn> -> updates [ create ] fmap <spacer>
+                    "Hint" <model-border-btn> -> "Solve" <model-border-btn> ->
+                ] <hbox> , roll [ swap updates ] curry bi@
+                [ [ hint ] fmap ] [ [ f solution ] fmap ] bi* 3array merge
+                [ [ [ number>string ] [ "" ] if* ] map ] fmap
+           ] bind
+        ] with-self ,
+    ] <vbox> { 280 220 } >>pref-dim ;
 
-MAIN: do-sudoku
+MAIN-WINDOW: sudoku-main
+    { { title "Sudoku Sleuth" } }
+    <sudoku-gadget> >>gadgets ;