changed frp demo to a gui sudoku solver

diff --git a/extra/darcs-ui b/extra/darcs-ui
deleted file mode 160000 (submodule)
index 8a2deaf..0000000
--- a/extra/darcs-ui
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 8a2deafe64cba990453126befbbbf2eed0ffd8f8

diff --git a/extra/gui-sudoku/authors.txt b/extra/gui-sudoku/authors.txt
new file mode 100644 (file)
index 0000000..ce0899f
--- /dev/null
+++ b/extra/gui-sudoku/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
\ No newline at end of file

diff --git a/extra/gui-sudoku/gui-sudoku.factor b/extra/gui-sudoku/gui-sudoku.factor
new file mode 100644 (file)
index 0000000..884271a
--- /dev/null
+++ b/extra/gui-sudoku/gui-sudoku.factor
@@ -0,0 +1,32 @@
+USING: accessors arrays combinators.short-circuit grouping kernel lists
+lists.lazy locals math math.functions math.parser math.ranges
+models.product monads random sequences sets ui ui.frp.gadgets
+ui.frp.layout ui.frp.signals ui.gadgets.alerts vectors ;
+IN: gui-sudoku
+
+: row ( index -- row ) 1 + 9 / ceiling ;
+: col ( index -- col ) 9 mod 1 + ;
+: sq ( index -- square ) [ row ] [ col ] bi [ 3 / ceiling ] bi@ 2array ;
+: near ( a pos -- ? ) { [ [ row ] bi@ = ] [ [ col ] bi@ = ] [ [ sq ] bi@ = ] } 2|| ;
+MEMO:: solutions ( puzzle -- solutions )
+    f puzzle index
+    [ :> pos
+      1 9 [a,b] 80 iota [ pos near ] filter [ puzzle nth ] map prune diff
+      [ 1array puzzle pos cut-slice rest surround ] map >list [ solutions ] bind
+    ] [ puzzle list-monad return ] if* ;
+
+: solution ( puzzle -- solution ) dup solutions dup +nil+ = [ drop "Unsolvable" alert* ] [ nip car ] if ;
+: hint ( puzzle -- puzzle' ) [ [ f swap indices random dup ] [ solution ] bi nth ] keep swapd >vector [ set-nth ] keep ;
+
+: do-sudoku ( -- ) [ [ [ $ SUDOKU $ ] <vbox> { 280 220 } >>pref-dim
+        [
+            81 [ "" ] replicate <basic> <switch> [ SUDOKU [ <basic> ] map 9 group [ 3 group ] map 3 group
+               [ [ [ <spacer> [ [ <frp-field> ->% 2 [ string>number ] fmap ]
+                    map <spacer> ] map concat ] <hbox> , ] map concat <spacer> ] map concat <product> dup
+               [ "Hint" <frp-border-button> -> "Solve" <frp-border-button> -> ] <hbox> , swapd [ <updates> ] 2bi@
+               [ [ hint ] fmap ] [ [ solution ] fmap ] bi* <2merge> [ [ [ number>string ] [ "" ] if* ] map ] fmap
+           ] bind
+        ] with-self SUDOKU ,
+    ] with-interface "Sudoku Sleuth" open-window ] with-ui ;
+
+MAIN: do-sudoku
\ No newline at end of file

diff --git a/extra/gui-sudoku/summary.txt b/extra/gui-sudoku/summary.txt
new file mode 100644 (file)
index 0000000..d66e7be
--- /dev/null
+++ b/extra/gui-sudoku/summary.txt
@@ -0,0 +1 @@
+graphical sudoku solver
\ No newline at end of file

diff --git a/extra/persistency/authors.txt b/extra/persistency/authors.txt
new file mode 100644 (file)
index 0000000..ce0899f
--- /dev/null
+++ b/extra/persistency/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
\ No newline at end of file

diff --git a/extra/recipes/authors.txt b/extra/recipes/authors.txt
new file mode 100644 (file)
index 0000000..ce0899f
--- /dev/null
+++ b/extra/recipes/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
\ No newline at end of file

diff --git a/extra/recipes/icons/back.tiff b/extra/recipes/icons/back.tiff
new file mode 100644 (file)
index 0000000..27b8112
Binary files /dev/null and b/extra/recipes/icons/back.tiff differ

diff --git a/extra/recipes/icons/hate.tiff b/extra/recipes/icons/hate.tiff
new file mode 100644 (file)
index 0000000..d7d5f8e
Binary files /dev/null and b/extra/recipes/icons/hate.tiff differ

diff --git a/extra/recipes/icons/love.tiff b/extra/recipes/icons/love.tiff
new file mode 100644 (file)
index 0000000..ae2fa7b
Binary files /dev/null and b/extra/recipes/icons/love.tiff differ

diff --git a/extra/recipes/icons/more.tiff b/extra/recipes/icons/more.tiff
new file mode 100644 (file)
index 0000000..b4ec27b
Binary files /dev/null and b/extra/recipes/icons/more.tiff differ

diff --git a/extra/recipes/icons/submit.tiff b/extra/recipes/icons/submit.tiff
new file mode 100644 (file)
index 0000000..7c98267
Binary files /dev/null and b/extra/recipes/icons/submit.tiff differ

diff --git a/extra/recipes/summary.txt b/extra/recipes/summary.txt
new file mode 100644 (file)
index 0000000..98b1ece
--- /dev/null
+++ b/extra/recipes/summary.txt
@@ -0,0 +1 @@
+Database backed recipe sharing
\ No newline at end of file

diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
new file mode 100644 (file)
index 0000000..37d1d94
--- /dev/null
+++ b/extra/sequences/extras/extras.factor
@@ -0,0 +1,22 @@
+USING: arrays kernel locals math sequences ;
+IN: sequences.extras
+: reduce1 ( seq quot -- result ) [ unclip ] dip reduce ; inline
+
+:: reduce-r
+    ( list identity quot: ( obj1 obj2 -- obj ) -- result )
+    list empty?
+    [ identity ]
+    [ list rest identity quot reduce-r list first quot call ] if ;
+    inline recursive
+
+! Quot must have static stack effect, unlike "reduce"
+:: reduce* ( seq id quot -- result ) seq
+    [ id ]
+    [ unclip id swap quot call( prev elt -- next ) quot reduce* ] if-empty ; inline recursive
+
+:: combos ( list1 list2 -- result ) list2 [ [ 2array ] curry list1 swap map ] map concat ;
+: (head-slice) ( seq n -- seq' ) over length over < [ drop ] [ head-slice ] if ;
+: find-all ( seq quot -- elts ) [ [ length iota ] keep ] dip
+    [ dupd call( a -- ? ) [ 2array ] [ 2drop f ] if ] curry 2map [ ] filter ; inline
+
+: empty ( seq -- ) 0 swap shorten ;
\ No newline at end of file