split + renamed ui.frp for better integration with other libs

extra/file-trees/file-trees.factor

@@ -1,6 +1,6 @@
 USING: accessors arrays delegate delegate.protocols
 io.pathnames kernel locals sequences
-vectors make strings ui.frp.signals ui.frp.gadgets
+vectors make strings models.combinators ui.gadgets.controls
 sequences.extras ;
 IN: file-trees
 
@@ -44,6 +44,6 @@ DEFER: (tree-insert)
    go-to-path ;
 
 : <dir-table> ( tree-model -- table )
-   <frp-list*> [ node>> 1array ] >>quot
-   [ selected-value>> [ file? not ] <filter> swap <switch> ]
+   <list*> [ node>> 1array ] >>quot
+   [ selected-value>> [ file? not ] filter-model swap switch-models ]
    [ swap >>model ] bi ;

extra/models/combinators/combinators-docs.factor

@@ -0,0 +1,41 @@
+USING: help.markup help.syntax models models.arrow sequences monads ;
+IN: models.combinators
+
+HELP: merge
+{ $values { "models" "a list of models" } { "model" basic-model } }
+{ $description "Creates a model that merges the updates of others" } ;
+
+HELP: filter-model
+{ $values { "model" model } { "quot" "quotation with stack effect ( a b -- c )" } { "filter-model" filter-model } }
+{ $description "Creates a model that uses the updates of another model only when they satisfy a given predicate" } ;
+
+HELP: fold
+{ $values { "oldval" "starting value" } { "quot" "applied to update and previous values" } { "model" model } { "model" model } }
+{ $description "Similar to " { $link reduce } " but works on models, applying a quotation to the previous and new values at each update" } ;
+
+HELP: switch-models
+{ $values { "model1" model } { "model2" model } { "model'" model } }
+{ $description "Creates a model that starts with the behavior of model2 and switches to the behavior of model1 on its update" } ;
+
+HELP: <mapped>
+{ $values { "model" model } { "quot" "applied to model's value on updates" } { "model" model } }
+{ $description "An expanded version of " { $link <arrow> } ". Use " { $link fmap } " instead." } ;
+
+HELP: when-model
+{ $values { "model" model } { "quot" "called on the model if the quot yields true" } { "cond" "a quotation called on the model's value, yielding a boolean value"  } }
+{ $description "Calls quot when model updates if its value meets the condition set in cond" } ;
+
+HELP: with-self
+{ $values { "quot" "quotation that recieves its own return value" } { "model" model } }
+{ $description "Fixed points for models: the quot reacts to the same model to gives" } ;
+
+HELP: #1
+{ $values { "model" model } { "model'" model } }
+{ $description "Moves a model to the top of its dependencies' connections, thus being notified before the others" } ;
+
+ARTICLE: "models.combinators" "Extending models"
+"The " { $vocab-link "models.combinators" } " library expands models to have discrete start and end times. "
+"Also, it provides methods of manipulating and combining models, expecially useful when programming user interfaces: "
+"The output models of some gadgets (see " { $vocab-link "ui.gadgets.controls" } " ) can be manipulated and used as the input models of others. " ;
+
+ABOUT: "models.combinators"

extra/models/combinators/combinators.factor

@@ -1,7 +1,7 @@
 USING: accessors arrays kernel models models.product monads
 sequences sequences.extras ;
 FROM: syntax => >> ;
-IN: ui.frp.signals
+IN: models.combinators
 
 TUPLE: multi-model < model important? ;
 GENERIC: (model-changed) ( model observer -- )
@@ -17,18 +17,18 @@ IN: models
     dup connections>> dup [ dup multi-model? [ important?>> ] [ drop f ] if ] find-all
     [ second tuck [ remove ] dip prefix ] each
     [ model-changed ] with each ;
-IN: ui.frp.signals
+IN: models.combinators
 
 TUPLE: basic-model < multi-model ;
 M: basic-model (model-changed) [ value>> ] dip set-model ;
-: <merge> ( models -- signal ) basic-model <multi-model> ;
-: <2merge> ( model1 model2 -- signal ) 2array <merge> ;
-: <basic> ( value -- signal ) basic-model new-model ;
+: merge ( models -- model ) basic-model <multi-model> ;
+: 2merge ( model1 model2 -- model ) 2array merge ;
+: <basic> ( value -- model ) basic-model new-model ;
 
 TUPLE: filter-model < multi-model quot ;
 M: filter-model (model-changed) [ value>> ] dip 2dup quot>> call( a -- ? )
    [ set-model ] [ 2drop ] if ;
-: <filter> ( model quot -- filter-signal ) [ 1array filter-model <multi-model> ] dip >>quot ;
+: filter-model ( model quot -- filter-model ) [ 1array \ filter-model <multi-model> ] dip >>quot ;
 
 TUPLE: fold-model < multi-model quot base values ;
 M: fold-model (model-changed) 2dup base>> =
@@ -38,16 +38,16 @@ M: fold-model (model-changed) 2dup base>> =
     ] if ;
 M: fold-model model-activated drop ;
 : new-fold-model ( deps -- model ) fold-model <multi-model> V{ } clone >>values ;
-: <fold> ( model oldval quot -- signal ) rot 1array new-fold-model swap >>quot
+: fold ( model oldval quot -- model ) rot 1array new-fold-model swap >>quot
    swap >>value ;
-: <fold*> ( model oldmodel quot -- signal ) over [ [ 2array new-fold-model ] dip >>quot ]
+: fold* ( model oldmodel quot -- model ) over [ [ 2array new-fold-model ] dip >>quot ]
     dip [ >>base ] [ value>> >>value ] bi ;
 
 TUPLE: updater-model < multi-model values updates ;
 M: updater-model (model-changed) [ tuck updates>> =
    [ [ values>> value>> ] keep set-model ]
    [ drop ] if ] keep f swap (>>value) ;
-: <updates> ( values updates -- signal ) [ 2array updater-model <multi-model> ] 2keep
+: updates ( values updates -- model ) [ 2array updater-model <multi-model> ] 2keep
    [ >>values ] [ >>updates ] bi* ;
 
 SYMBOL: switch
@@ -55,7 +55,7 @@ TUPLE: switch-model < multi-model original switcher on ;
 M: switch-model (model-changed) 2dup switcher>> =
    [ [ value>> ] dip over switch = [ nip [ original>> ] keep f >>on model-changed ] [ t >>on set-model ] if ]
    [ dup on>> [ 2drop ] [ [ value>> ] dip over [ set-model ] [ 2drop ] if ] if ] if ;
-: <switch> ( signal1 signal2 -- signal' ) swap [ 2array switch-model <multi-model> ] 2keep
+: switch-models ( model1 model2 -- model' ) swap [ 2array switch-model <multi-model> ] 2keep
    [ [ value>> >>value ] [ >>original ] bi ] [ >>switcher ] bi* ;
 M: switch-model model-activated [ original>> ] keep model-changed ;
 : >behavior ( event -- behavior ) t >>value ;
@@ -63,7 +63,7 @@ M: switch-model model-activated [ original>> ] keep model-changed ;
 TUPLE: mapped-model < multi-model model quot ;
 : new-mapped-model ( model quot class -- mapped-model ) [ over 1array ] dip
    <multi-model> swap >>quot swap >>model ;
-: <mapped> ( model quot -- signal ) mapped-model new-mapped-model ;
+: <mapped> ( model quot -- model ) mapped-model new-mapped-model ;
 M: mapped-model (model-changed)
     [ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi
     set-model ;
@@ -81,7 +81,7 @@ M: action-value model-activated dup parent>> dup activate-model model-changed ;
 TUPLE: action < multi-model quot ;
 M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep value>>
    [ swap add-connection ] 2keep model-changed ;
-: <action> ( model quot -- action-signal ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
+: <action> ( model quot -- action-model ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
 
 TUPLE: collection < multi-model ;
 : <collection> ( models -- product ) collection <multi-model> ;
@@ -93,13 +93,13 @@ M: collection (model-changed)
 M: collection model-activated dup (model-changed) ;
 
 ! for side effects
-TUPLE: (frp-when) < multi-model quot cond ;
-: frp-when ( model quot cond -- model ) rot 1array (frp-when) <multi-model> swap >>cond swap >>quot ;
-M: (frp-when) (model-changed) [ quot>> ] 2keep
+TUPLE: (when-model) < multi-model quot cond ;
+: when-model ( model quot cond -- model ) rot 1array (when-model) <multi-model> swap >>cond swap >>quot ;
+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
 
-USE: ui.frp.signals.templates
+USE: models.combinators.templates
 << { "$>" "<$" "fmap" } [ fmaps ] each >>

extra/models/combinators/summary.txt

@@ -0,0 +1 @@
+Model combination and manipulation

extra/models/combinators/templates/templates.factor

@@ -1,6 +1,6 @@
 USING: kernel sequences functors fry macros generalizations ;
-IN: ui.frp.signals.templates
-FROM: ui.frp.signals => <collection> #1 ;
+IN: models.combinators.templates
+FROM: models.combinators => <collection> #1 ;
 FUNCTOR: fmaps ( W -- )
 W        IS ${W}
 w-n      DEFINES ${W}-n

extra/modules/rpc-server/rpc-server.factor

@@ -25,12 +25,11 @@ SYMBOL: serving-vocabs serving-vocabs [ V{ } clone ] initialize
 : register-loads-thread ( -- )
     [ [ receive vocab ] keep reply-synchronous t ] "load-words" spawn-server "loads-thread" swap register-process ;
 
-: add-vocabs-hook ( -- )
-    [ 9012 start-node
-        register-gets-thread
-        register-does-thread
-        register-loads-thread
-    ] "start-serving-vocabs" add-init-hook ;
 PRIVATE>
-SYNTAX: service add-vocabs-hook
-    current-vocab name>> serving-vocabs get-global adjoin ;
+SYNTAX: service current-vocab name>> serving-vocabs get-global adjoin ;
+
+[ 9012 start-node
+    register-gets-thread
+    register-does-thread
+    register-loads-thread
+] "start-serving-vocabs" add-init-hook

extra/recipes/recipes.factor

@@ -1,14 +1,14 @@
 USING: accessors arrays colors.constants combinators db.queries
-db.info db.tuples db.types kernel locals math
-monads persistency sequences sequences.extras ui ui.frp.gadgets
-ui.frp.layout ui.frp.signals ui.gadgets.labels
-ui.gadgets.scrollers ui.pens.solid ;
+db.sqlite db.tuples db.types kernel locals math
+monads persistency sequences sequences.extras ui ui.gadgets.controls
+ui.gadgets.layout models.combinators ui.gadgets.labels
+ui.gadgets.scrollers ui.pens.solid io.files.temp ;
 FROM: sets => prune ;
 IN: recipes
 
 STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } { genre { VARCHAR 100 } } ;
 : <recipe> ( title genre text -- recipe ) recipe new swap >>txt swap >>genre swap >>title 0 >>votes ;
-get-psql-info recipe define-db
+"recipes.db" temp-file <sqlite-db> recipe define-db
 : top-recipes ( offset search -- recipes ) <query> T{ recipe } rot >>title >>tuple
     "votes" >>order 30 >>limit swap >>offset get-tuples ;
 : top-genres ( -- genres ) f f top-recipes [ genre>> ] map prune 4 (head-slice) ;
@@ -25,37 +25,37 @@ get-psql-info recipe define-db
         $ BODY $
         $ BUTTON $
      ] <vbox> ,
-  ] <frp-book*> { 350 245 } >>pref-dim ;
+  ] <book*> { 350 245 } >>pref-dim ;
   
 :: recipe-browser ( -- ) [ [
     interface
-      <frp-table*> :> tbl
-      "okay" <frp-border-button> BUTTON -> :> ok
-      IMG-FRP-BTN: submit [ store-tuple ] >>value TOOLBAR -> :> submit
-      IMG-FRP-BTN: love 1 >>value TOOLBAR ->
-      IMG-FRP-BTN: hate -1 >>value -> 2array <merge> :> votes
-      IMG-FRP-BTN: back -> [ -30 ] <$
-      IMG-FRP-BTN: more -> [ 30 ] <$ 2array <merge> :> viewed
-      <spacer> <frp-field*> ->% 1 :> search
-      submit ok [ [ drop ] ] <$ 2array <merge> [ drop ] >>value :> quot
-      viewed 0 [ + ] <fold> search ok t <basic> "all" <frp-button> ALL ->
+      <table*> :> tbl
+      "okay" <model-border-btn> BUTTON -> :> ok
+      IMG-MODEL-BTN: submit [ store-tuple ] >>value TOOLBAR -> :> submit
+      IMG-MODEL-BTN: love 1 >>value TOOLBAR ->
+      IMG-MODEL-BTN: hate -1 >>value -> 2array merge :> votes
+      IMG-MODEL-BTN: back -> [ -30 ] <$
+      IMG-MODEL-BTN: more -> [ 30 ] <$ 2array merge :> viewed
+      <spacer> <model-field*> ->% 1 :> search
+      submit ok [ [ drop ] ] <$ 2array merge [ drop ] >>value :> quot
+      viewed 0 [ + ] fold search ok t <basic> "all" <model-btn> ALL ->
       tbl selected-value>> votes [ [ + ] curry change-votes modify-tuple ] 2$>
-        4array <merge>
-        [ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap :> updates
-      updates [ top-genres [ <frp-button> GENRES -> ] map <merge> ] bind*
+        4array merge
+        [ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap :> ups
+      ups [ top-genres [ <model-btn> GENRES -> ] map merge ] bind*
         [ text>> T{ recipe } swap >>genre get-tuples ] fmap
-      tbl swap updates 2array <merge> >>model
+      tbl swap ups 2merge >>model
         [ [ title>> ] [ genre>> ] bi 2array ] >>quot
         { "Title" "Genre" } >>column-titles dup <scroller> RECIPES ,% 1 actions>>
-      submit [ "" dup dup <recipe> ] <$ 2array <merge>
-        { [ [ title>> ] fmap <frp-field> TITLE ->% .5 ]
-          [ [ genre>> ] fmap <frp-field> GENRE ->% .5 ]
-          [ [ txt>> ] fmap <frp-editor> BODY ->% 1 ]
+      submit [ "" dup dup <recipe> ] <$ 2array merge
+        { [ [ title>> ] fmap <model-field> TITLE ->% .5 ]
+          [ [ genre>> ] fmap <model-field> GENRE ->% .5 ]
+          [ [ txt>> ] fmap <model-editor> BODY ->% 1 ]
         } cleave
         [ <recipe> ] 3fmap
       [ [ 1 ] <$ ]
-      [ quot ok <updates> #1 [ call( recipe -- ) 0 ] 2fmap ] bi
-      2array <merge> 0 <basic> <switch> >>model
+      [ quot ok updates #1 [ call( recipe -- ) 0 ] 2fmap ] bi
+      2merge 0 <basic> switch-models >>model
    ] with-interface "recipes" open-window ] with-ui ;
 
 MAIN: recipe-browser

extra/sudokus/sudokus.factor

@@ -1,8 +1,8 @@
 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 fry
-ui.gadgets.labels memoize ;
+models.product monads random sequences sets ui ui.gadgets.controls
+ui.gadgets.layout models.combinators ui.gadgets.alerts vectors fry
+ui.gadgets.labels ;
 IN: sudokus
 
 : row ( index -- row ) 1 + 9 / ceiling ;
@@ -11,28 +11,28 @@ IN: sudokus
 : near ( a pos -- ? ) { [ [ row ] bi@ = ] [ [ col ] bi@ = ] [ [ sq ] bi@ = ] } 2|| ;
 : nth-or-lower ( n seq -- elt ) [ length 1 - 2dup > [ nip ] [ drop ] if ] keep nth ;
 
-MEMO:: solutions ( puzzle random? -- solutions )
+:: 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 prune diff
       [ 1array puzzle pos cut-slice rest surround ] map >list [ random? solutions ] bind
     ] [ puzzle list-monad return ] if* ;
 
-: solution ( puzzle random? -- solution ) dupd solutions dup +nil+ = [ drop "Unsolvable" alert* ] [ nip car ] if \ solutions reset-memoized ;
+: solution ( puzzle random? -- solution ) dupd solutions dup +nil+ = [ drop "Unsolvable" alert* ] [ nip car ] if ;
 : hint ( puzzle -- puzzle' ) [ [ f swap indices random dup ] [ f solution ] bi nth ] keep swapd >vector [ set-nth ] keep ;
 : create ( difficulty -- puzzle ) 81 [ f ] replicate
     40 random solution [ [ dup length random f spin set-nth ] curry times ] keep ;
 
 : do-sudoku ( -- ) [ [
         [
-            81 [ "" ] replicate <basic> <switch> [ [ <basic> ] map 9 group [ 3 group ] map 3 group
-               [ [ [ <spacer> [ [ <frp-field> ->% 2 [ string>number ] fmap ]
+            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> <frp-field> -> [ string>number 1 or 1 + 10 * ] fmap
-               "Generate" <frp-border-button> -> <updates> [ create ] fmap <spacer>
-               "Hint" <frp-border-button> -> "Solve" <frp-border-button> -> ] <hbox> ,
-               roll [ swap <updates> ] curry bi@
-               [ [ hint ] fmap ] [ [ f solution ] fmap ] bi* 3array <merge> [ [ [ number>string ] [ "" ] if* ] map ] fmap
+               [ "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 ;

extra/ui/frp/gadgets/gadgets.factor

@@ -1,83 +0,0 @@
-USING: accessors assocs arrays kernel models monads sequences
-ui.frp.signals ui.gadgets ui.gadgets.borders ui.gadgets.buttons
-ui.gadgets.buttons.private ui.gadgets.editors words images.loader
-ui.gadgets.scrollers ui.gadgets.tables ui.images vocabs.parser lexer
-models.range ui.gadgets.sliders ;
-IN: ui.frp.gadgets
-
-TUPLE: frp-button < button hook value ;
-: <frp-button> ( gadget -- button ) [
-      [ dup hook>> [ call( button -- ) ] [ drop ] if* ]
-      [ [ [ value>> ] [ ] bi or ] keep set-control-value ]
-      [ model>> f swap (>>value) ] tri
-   ] frp-button new-button f <basic> >>model ;
-: <frp-border-button> ( text -- button ) <frp-button> border-button-theme ;
-
-TUPLE: frp-table < table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment actions ;
-M: frp-table column-titles column-titles>> ;
-M: frp-table column-alignment column-alignment>> ;
-M: frp-table row-columns quot>> [ call( a -- b ) ] [ drop f ] if* ;
-M: frp-table row-value val-quot>> [ call( a -- b ) ]  [ drop f ] if* ;
-M: frp-table row-color color-quot>> [ call( a -- b ) ]  [ drop f ] if* ;
-
-: new-frp-table ( model class -- table ) f swap new-table dup >>renderer
-   V{ } clone <basic> >>selected-values V{ } clone <basic> >>selected-indices*
-   f <basic> >>actions dup [ actions>> set-model ] curry >>action ;
-: <frp-table> ( model -- table ) frp-table new-frp-table ;
-: <frp-table*> ( -- table ) V{ } clone <model> <frp-table> ;
-: <frp-list> ( column-model -- table ) <frp-table> [ 1array ] >>quot ;
-: <frp-list*> ( -- table ) V{ } clone <model> <frp-list> ;
-: indexed ( table -- table ) f >>val-quot ;
-
-TUPLE: frp-field < field frp-model ;
-: init-field ( field -- field' ) [ [ ] [ "" ] if* ] change-value ;
-: <frp-field> ( model -- gadget ) frp-field new-field swap init-field >>frp-model ;
-M: frp-field graft*
-    [ [ frp-model>> value>> ] [ editor>> ] bi set-editor-string ]
-    [ dup editor>> model>> add-connection ]
-    [ dup frp-model>> add-connection ] tri ;
-M: frp-field ungraft*
-   [ dup editor>> model>> remove-connection ]
-   [ dup frp-model>> remove-connection ] bi ;
-M: frp-field model-changed 2dup frp-model>> =
-    [ [ value>> ] [ editor>> ] bi* set-editor-string ]
-    [ nip [ editor>> editor-string ] [ frp-model>> ] bi set-model ] if ;
-
-: <frp-field*> ( -- field ) "" <model> <frp-field> ;
-: <empty-field> ( model -- field ) "" <model> <switch> <frp-field> ;
-: <frp-editor> ( model -- gadget )
-    frp-field [ <multiline-editor> ] dip new-border dup gadget-child >>editor
-    field-theme swap init-field >>frp-model { 1 0 } >>align ;
-: <frp-editor*> ( -- editor ) "" <model> <frp-editor> ;
-: <empty-editor> ( model -- editor ) "" <model> <switch> <frp-editor> ;
-
-: <frp-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
-    f <model> >>model ;
-
-: <frp-slider> ( init page min max step -- slider ) <range> horizontal <slider> ;
-
-: image-prep ( -- image ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround <image-name> dup cached-image drop ;
-SYNTAX: IMG-FRP-BTN: image-prep [ <frp-button> ] curry over push-all ;
-
-SYNTAX: IMG-BTN: image-prep [ swap <button> ] curry over push-all ;
-
-GENERIC: output-model ( gadget -- model )
-M: gadget output-model model>> ;
-M: table output-model dup multiple-selection?>>
-   [ dup val-quot>> [ selected-values>> ] [ selected-indices*>> ] if ]
-   [ dup val-quot>> [ selected-value>> ] [ selected-index*>> ] if ] if ;
-M: frp-field output-model frp-model>> ;
-M: scroller output-model viewport>> children>> first output-model ;
-M: slider output-model model>> range-model ;
-
-IN: accessors
-M: frp-button text>> children>> first text>> ;
-
-IN: ui.frp.gadgets
-
-SINGLETON: gadget-monad
-INSTANCE: gadget-monad monad
-INSTANCE: gadget monad
-M: gadget monad-of drop gadget-monad ;
-M: gadget-monad return drop <gadget> swap >>model ;
-M: gadget >>= output-model [ swap call( x -- y ) ] curry ; 

extra/ui/frp/gadgets/summary.txt

@@ -1 +0,0 @@
-Gadgets using signals as their models

extra/ui/frp/signals/signals-docs.factor

@@ -1,49 +0,0 @@
-USING: help.markup help.syntax models models.arrow sequences ui.frp.signals monads ;
-IN: ui.frp.signals
-
-HELP: <merge>
-{ $values { "models" "a list of models" } { "signal" basic-model } }
-{ $description "Creates a signal that merges the updates of others" } ;
-
-HELP: <filter>
-{ $values { "model" model } { "quot" "quotation with stack effect ( a b -- c )" } { "filter-signal" filter-model } }
-{ $description "Creates a signal that uses the updates of another model only when they satisfy a given predicate" } ;
-
-HELP: <fold>
-{ $values { "oldval" "starting value" } { "quot" "applied to update and previous values" } { "model" model } { "signal" model } }
-{ $description "Similar to " { $link reduce } " but works on models, applying a quotation to the previous and new values at each update" } ;
-
-HELP: <switch>
-{ $values { "signal1" model } { "signal2" model } { "signal'" model } }
-{ $description "Creates a signal that starts with the behavior of signal2 and switches to the behavior of signal1 on its update" } ;
-
-HELP: <mapped>
-{ $values { "model" model } { "quot" "applied to model's value on updates" } { "signal" model } }
-{ $description "The signal version of an " { $link <arrow> } } ;
-
-HELP: $>
-{ $values { "model" model } { "quot" "applied to model's value on updates" } { "signal" model } }
-{ $description "Like " { $link <mapped> } ", but doesn't produce a new value" } ;
-
-HELP: <$
-{ $values { "model" model } { "quot" "applied to model's value on updates" } { "signal" model } }
-{ $description "Opposite of " { $link <$ } "- gives output, but takes no input" } ;
-
-HELP: frp-when
-{ $values { "model" model } { "quot" "called on the model if the quot yields true" } { "cond" "a quotation called on the model's value, yielding a boolean value"  } }
-{ $description "Calls quot when model updates if its value meets the condition set in cond" } ;
-
-HELP: with-self
-{ $values { "quot" "quotation that recieves its own return value" } { "model" model } }
-{ $description "Fixed points for signals: the quot reacts to the same signal to gives" } ;
-
-HELP: #1
-{ $values { "model" model } { "model'" model } }
-{ $description "Moves a signal to the top of its dependencies' connections, thus being notified before the others" } ;
-
-ARTICLE: "signals" "FRP Signals"
-"Unlike models, which always have a value, signals have discrete start and end times. "
-"They are the core of the frp library: program flow using frp is controlled entirely through manipulating and combining signals. "
-"The output signals of some gadgets (see " { $vocab-link "ui.frp.gadgets" } " ) can be manipulated and used as the input signals of others. " ;
-
-ABOUT: "signals"

extra/ui/frp/signals/summary.txt

@@ -1 +0,0 @@
-Utilities for functional reactive programming in user interfaces

extra/ui/gadgets/alerts/alerts.factor

@@ -1,5 +1,5 @@
 USING: accessors models monads macros generalizations kernel
-ui ui.frp.gadgets ui.frp.signals ui.frp.layout ui.gadgets
+ui ui.gadgets.controls models.combinators ui.gadgets.layout ui.gadgets
 ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
 ui.gadgets.packs locals sequences fonts io.styles
 wrap.strings ;
@@ -13,16 +13,16 @@ IN: ui.gadgets.alerts
 
 :: ask-user ( string -- model' )
    [ [let | lbl  [ string <label>  T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
-            fldm [ <frp-field*> ->% 1 ]
-            btn  [ "okay" <frp-border-button> ] |
-         btn -> [ fldm swap <updates> ]
+            fldm [ <model-field*> ->% 1 ]
+            btn  [ "okay" <model-border-btn> ] |
+         btn -> [ fldm swap updates ]
                 [ [ drop lbl close-window ] $> , ] bi
    ] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
 
 MACRO: ask-buttons ( buttons -- quot ) dup length [
       [ swap
          [ 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font ,
-         [ [ <frp-border-button> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
+         [ [ <model-border-btn> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
          "" open-window
       ] dip firstn
    ] 2curry ;

extra/ui/gadgets/comboboxes/comboboxes.factor

@@ -1,14 +1,15 @@
 USING: accessors arrays kernel math.rectangles sequences
-ui.frp.gadgets ui.frp.signals ui.gadgets ui.gadgets.glass
-ui.gadgets.labels ui.gadgets.tables ui.gestures ;
+ui.gadgets.controls models.combinators ui.gadgets ui.gadgets.glass
+ui.gadgets.labels ui.gestures ;
+QUALIFIED-WITH: ui.gadgets.tables tbl
 IN: ui.gadgets.comboboxes
 
-TUPLE: combo-table < frp-table spawner ;
+TUPLE: combo-table < table spawner ;
 
 M: combo-table handle-gesture [ call-next-method drop ] 2keep swap
    T{ button-up } = [
       [ spawner>> ]
-      [ selected-row [ swap set-control-value ] [ 2drop ] if ]
+      [ tbl:selected-row [ swap set-control-value ] [ 2drop ] if ]
       [ hide-glass ] tri
    ] [ drop ] if t ;
 
@@ -18,4 +19,4 @@ combobox H{
 } set-gestures
 
 : <combobox> ( options -- combobox ) [ first [ combobox new-label ] keep <basic> >>model ] keep
-    <basic> combo-table new-frp-table [ 1array ] >>quot >>table ;
+    <basic> combo-table new-table [ 1array ] >>quot >>table ;

extra/ui/gadgets/controls/controls-docs.factor

@@ -1,40 +1,40 @@
 USING: accessors help.markup help.syntax ui.gadgets.buttons
-ui.gadgets.editors ui.frp.gadgets models ui.gadgets ;
-IN: ui.frp.gadgets
+ui.gadgets.editors models ui.gadgets ;
+IN: ui.gadgets.controls
 
-HELP: <frp-button>
+HELP: <model-btn>
 { $values { "gadget" "the button's label" } { "button" button } }
 { $description "Creates an button whose signal updates on clicks.  " } ;
 
-HELP: <frp-border-button>
+HELP: <model-border-btn>
 { $values { "text" "the button's label" } { "button" button } }
 { $description "Creates an button whose signal updates on clicks.  " } ;
 
-HELP: <frp-table>
-{ $values { "model" "values the table is to display" } { "table" frp-table } }
-{ $description "Creates an " { $link frp-table } } ;
+HELP: <table>
+{ $values { "model" "values the table is to display" } { "table" table } }
+{ $description "Creates an " { $link table } } ;
 
-HELP: <frp-table*>
-{ $values { "table" frp-table } }
-{ $description "Creates an " { $link frp-table } " with no initial values to display" } ;
+HELP: <table*>
+{ $values { "table" table } }
+{ $description "Creates an " { $link table } " with no initial values to display" } ;
 
-HELP: <frp-list>
-{ $values { "column-model" "values the table is to display" } { "table" frp-table } }
-{ $description "Creates an " { $link frp-table } " with a val-quot that renders each element as its own row" } ;
+HELP: <list>
+{ $values { "column-model" "values the table is to display" } { "table" table } }
+{ $description "Creates an " { $link table } " with a val-quot that renders each element as its own row" } ;
 
-HELP: <frp-list*>
-{ $values { "table" frp-table } }
-{ $description "Creates an frp-list with no initial values to display" } ;
+HELP: <list*>
+{ $values { "table" table } }
+{ $description "Creates an model-list with no initial values to display" } ;
 
 HELP: indexed
-{ $values { "table" frp-table } }
-{ $description "Sets the output model of an frp-table to the selected-index, rather than the selected-value" } ;
+{ $values { "table" table } }
+{ $description "Sets the output model of an table to the selected-index, rather than the selected-value" } ;
 
-HELP: <frp-field>
+HELP: <model-field>
 { $values { "model" model } { "gadget" model-field } }
 { $description "Creates a field with an initial value" } ;
 
-HELP: <frp-field*>
+HELP: <model-field*>
 { $values { "field" model-field } }
 { $description "Creates a field with an empty initial value" } ;
 
@@ -42,11 +42,11 @@ HELP: <empty-field>
 { $values { "model" model } { "field" model-field } }
 { $description "Creates a field with an empty initial value that switches to another signal on its update" } ;
 
-HELP: <frp-editor>
+HELP: <model-editor>
 { $values { "model" model } { "gadget" model-field } }
 { $description "Creates an editor with an initial value" } ;
 
-HELP: <frp-editor*>
+HELP: <model-editor*>
 { $values { "editor" "an editor" } }
 { $description "Creates a editor with an empty initial value" } ;
 
@@ -54,16 +54,16 @@ HELP: <empty-editor>
 { $values { "model" model } { "editor" "an editor" } }
 { $description "Creates a field with an empty initial value that switches to another signal on its update" } ;
 
-HELP: <frp-action-field>
+HELP: <model-action-field>
 { $values { "field" action-field } }
 { $description "Field that updates its model with its contents when the user hits the return key" } ;
 
-HELP: IMG-FRP-BTN:
-{ $syntax "IMAGE-BUTTON: filename" }
+HELP: IMG-MODEL-BTN:
+{ $syntax "IMAGE-MODEL-BTN: filename" }
 { $description "Creates a button using a tiff image named as specified found in the icons subdirectory of the vocabulary path" } ;
 
 HELP: IMG-BTN:
-{ $syntax "[ do-something ] IMAGE-BUTTON: filename" }
+{ $syntax "[ do-something ] IMAGE-BTN: filename" }
 { $description "Creates a button using a tiff image named as specified found in the icons subdirectory of the vocabulary path, calling the specified quotation on click" } ;
 
 HELP: output-model

extra/ui/gadgets/controls/controls.factor

@@ -0,0 +1,87 @@
+USING: accessors assocs arrays kernel models monads sequences
+models.combinators ui.gadgets ui.gadgets.borders ui.gadgets.buttons
+ui.gadgets.buttons.private ui.gadgets.editors words images.loader
+ui.gadgets.scrollers ui.images vocabs.parser lexer
+models.range ui.gadgets.sliders ;
+QUALIFIED-WITH: ui.gadgets.sliders slider
+QUALIFIED-WITH: ui.gadgets.tables tbl
+EXCLUDE: ui.gadgets.editors => model-field ;
+IN: ui.gadgets.controls
+
+TUPLE: model-btn < button hook value ;
+: <model-btn> ( gadget -- button ) [
+      [ dup hook>> [ call( button -- ) ] [ drop ] if* ]
+      [ [ [ value>> ] [ ] bi or ] keep set-control-value ]
+      [ model>> f swap (>>value) ] tri
+   ] model-btn new-button f <basic> >>model ;
+: <model-border-btn> ( text -- button ) <model-btn> border-button-theme ;
+
+TUPLE: table < tbl:table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment actions ;
+M: table tbl:column-titles column-titles>> ;
+M: table tbl:column-alignment column-alignment>> ;
+M: table tbl:row-columns quot>> [ call( a -- b ) ] [ drop f ] if* ;
+M: table tbl:row-value val-quot>> [ call( a -- b ) ]  [ drop f ] if* ;
+M: table tbl:row-color color-quot>> [ call( a -- b ) ]  [ drop f ] if* ;
+
+: new-table ( model class -- table ) f swap tbl:new-table dup >>renderer
+   V{ } clone <basic> >>selected-values V{ } clone <basic> >>selected-indices*
+   f <basic> >>actions dup [ actions>> set-model ] curry >>action ;
+: <table> ( model -- table ) table new-table ;
+: <table*> ( -- table ) V{ } clone <model> <table> ;
+: <list> ( column-model -- table ) <table> [ 1array ] >>quot ;
+: <list*> ( -- table ) V{ } clone <model> <list> ;
+: indexed ( table -- table ) f >>val-quot ;
+
+TUPLE: model-field < field model* ;
+: init-field ( field -- field' ) [ [ ] [ "" ] if* ] change-value ;
+: <model-field> ( model -- gadget ) model-field new-field swap init-field >>model* ;
+M: model-field graft*
+    [ [ model*>> value>> ] [ editor>> ] bi set-editor-string ]
+    [ dup editor>> model>> add-connection ]
+    [ dup model*>> add-connection ] tri ;
+M: model-field ungraft*
+   [ dup editor>> model>> remove-connection ]
+   [ dup model*>> remove-connection ] bi ;
+M: model-field model-changed 2dup model*>> =
+    [ [ value>> ] [ editor>> ] bi* set-editor-string ]
+    [ nip [ editor>> editor-string ] [ model*>> ] bi set-model ] if ;
+
+: <model-field*> ( -- field ) "" <model> <model-field> ;
+: <empty-field> ( model -- field ) "" <model> switch-models <model-field> ;
+: (model-editor) ( model class -- gadget )
+    model-field [ new-editor ] dip new-border dup gadget-child >>editor
+    field-theme swap init-field >>model* { 1 0 } >>align ;
+: <model-editor> ( model -- gadget ) multiline-editor (model-editor) ;
+: <model-editor*> ( -- editor ) "" <model> <model-editor> ;
+: <empty-editor> ( model -- editor ) "" <model> switch-models <model-editor> ;
+
+: <model-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
+    f <model> >>model ;
+
+: <slider> ( init page min max step -- slider ) <range> horizontal slider:<slider> ;
+
+: image-prep ( -- image ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround <image-name> dup cached-image drop ;
+SYNTAX: IMG-MODEL-BTN: image-prep [ <model-btn> ] curry over push-all ;
+
+SYNTAX: IMG-BTN: image-prep [ swap <button> ] curry over push-all ;
+
+GENERIC: output-model ( gadget -- model )
+M: gadget output-model model>> ;
+M: table output-model dup multiple-selection?>>
+   [ dup val-quot>> [ selected-values>> ] [ selected-indices*>> ] if ]
+   [ dup val-quot>> [ selected-value>> ] [ selected-index*>> ] if ] if ;
+M: model-field output-model model*>> ;
+M: scroller output-model viewport>> children>> first output-model ;
+M: slider output-model model>> range-model ;
+
+IN: accessors
+M: model-btn text>> children>> first text>> ;
+
+IN: ui.gadgets.controls
+
+SINGLETON: gadget-monad
+INSTANCE: gadget-monad monad
+INSTANCE: gadget monad
+M: gadget monad-of drop gadget-monad ;
+M: gadget-monad return drop <gadget> swap >>model ;
+M: gadget >>= output-model [ swap call( x -- y ) ] curry ; 

extra/ui/gadgets/controls/summary.txt

@@ -0,0 +1 @@
+Gadgets with expanded model usage

extra/ui/gadgets/layout/layout-docs.factor

@@ -1,5 +1,5 @@
-USING: help.markup help.syntax models ui.gadgets.tracks ui.frp.layout ;
-IN: ui.frp.layout
+USING: help.markup help.syntax models ui.gadgets.tracks ;
+IN: ui.gadgets.layout
 
 HELP: ,
 { $values { "item" "a gadget or model" } }
@@ -38,16 +38,16 @@ HELP: with-interface
 { $values { "quot" "quotation that builds a template and inserts into it" } }
 { $description "Create templates, used with " { $link POSTPONE: $ } } ;
 
-ARTICLE: "ui.frp.layout" "GUI Layout"
+ARTICLE: "ui.gadgets.layout" "GUI Layout"
 "Laying out GUIs works the same way as building lists with " { $vocab-link "make" }
 ". Gadgets are layed out using " { $vocab-link "ui.gadgets.tracks" } " through " { $link <hbox> } " and " { $link <vbox> } ", which allow both fixed and percentage widths. "
-{ $link , } " and " { $link -> }  " add a signal or gadget to the gadget you're building. "
-"Also, books can be made with " { $link <frp-book> } ". "
+{ $link , } " and " { $link -> }  " add a model or gadget to the gadget you're building. "
+"Also, books can be made with " { $link <book> } ". "
 { $link <spacer> } "s add flexable space between items. " $nl
 "Using " { $link with-interface } ", one can pre-build templates to add items to later: "
 "Like in the StringTemplate framework for java, placeholders are defined using $ PLACERHOLDER-NAME $ "
 "Using PLACEHOLDER-NAME again sets it as the current insertion point. "
 "For examples using normal layout, see the " { $vocab-link "sudokus" } " demo. "
-"For examples of templating, see " { $vocab-link "recipes" } " demo. " ;
+"For examples of templating, see the " { $vocab-link "recipes" } " demo. " ;
 
-ABOUT: "ui.frp.layout"
+ABOUT: "ui.gadgets.layout"

extra/ui/gadgets/layout/layout.factor

@@ -1,9 +1,10 @@
 USING: accessors assocs arrays fry kernel lexer make math.parser
 models monads namespaces parser sequences
-sequences.extras ui.frp.gadgets ui.frp.signals ui.gadgets
-ui.gadgets.books ui.gadgets.tracks words ;
+sequences.extras models.combinators ui.gadgets
+ui.gadgets.tracks words ui.gadgets.controls ;
 QUALIFIED: make
-IN: ui.frp.layout
+QUALIFIED-WITH: ui.gadgets.books book
+IN: ui.gadgets.layout
 
 SYMBOL: templates
 TUPLE: layout gadget size ; C: <layout> layout
@@ -47,9 +48,9 @@ M: model -> dup , ;
 : <hbox> ( gadgets -- track ) horizontal <box> ; inline
 : <vbox> ( gadgets -- track ) vertical <box> ; inline
 
-: make-book ( models gadgets model -- book ) <book> swap [ "No models in books" throw ] unless-empty ;
-: <frp-book> ( quot: ( -- model ) -- book ) f make-layout rot 0 >>value make-book ; inline
-: <frp-book*> ( quot -- book ) f make-layout f make-book ; inline
+: make-book ( models gadgets model -- book ) book:<book> swap [ "No models in books" throw ] unless-empty ;
+: <book> ( quot: ( -- model ) -- book ) f make-layout rot 0 >>value make-book ; inline
+: <book*> ( quot -- book ) f make-layout f make-book ; inline
 
 ERROR: not-in-template word ;
 SYNTAX: $ CREATE-WORD dup
@@ -58,16 +59,17 @@ SYNTAX: $ CREATE-WORD dup
 
 : insert-gadget ( number parent gadget -- ) -rot [ but-last insert-nth ] change-children drop ;
 : insert-size ( number parent size -- ) -rot [ but-last insert-nth ] change-sizes drop ;
-: insertion-point ( gadget placeholder -- number parent gadget ) dup parent>> [ children>> index ] keep rot ;
+: insertion-point ( placeholder -- number parent ) dup parent>> [ children>> index ] keep ;
 
-GENERIC# (insert-item) 1 ( item location -- )
-M: gadget (insert-item) dup parent>> track? [ [ f <layout> ] dip (insert-item) ]
-    [ insertion-point [ add-gadget ] keep insert-gadget ] if ;
-M: layout (insert-item) insertion-point [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
-M: model (insert-item) parent>> dup book? [ "No models in books" throw ]
+GENERIC# add-gadget-at 1 ( item location -- )
+M: gadget add-gadget-at dup parent>> track? [ [ f <layout> ] dip add-gadget-at ]
+    [ insertion-point rot [ add-gadget ] keep insert-gadget ] if ;
+M: layout add-gadget-at insertion-point rot [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
+M: model add-gadget-at parent>> dup book:book? [ "No models in books" throw ]
    [ dup model>> dup collection? [ nip swap add-connection ] [ drop [ 1array <collection> ] dip (>>model) ] if ] if ;
+: track-add-at ( item location size -- ) swap [ <layout> ] dip add-gadget-at ;
 : insert-item ( item location -- ) [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri
-    [ add-member ] 2keep (insert-item) ;
+    [ add-member ] 2keep add-gadget-at ;
 
 : insert-items ( makelist -- ) t swap [ dup placeholder? [ nip ] [ over insert-item ] if ] each drop ;