From 7f33da63ce06560dfd3bdc88a3d0274fcb461dec Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sat, 1 Aug 2009 15:18:24 -0500 Subject: [PATCH] split + renamed ui.frp for better integration with other libs --- extra/file-trees/file-trees.factor | 6 +- .../combinators}/authors.txt | 0 .../combinators/combinators-docs.factor | 41 +++++++++ .../combinators/combinators.factor} | 32 +++---- extra/models/combinators/summary.txt | 1 + .../combinators}/templates/templates.factor | 4 +- extra/modules/rpc-server/rpc-server.factor | 15 ++-- extra/recipes/recipes.factor | 52 +++++------ extra/sudokus/sudokus.factor | 24 ++--- extra/ui/frp/gadgets/gadgets.factor | 83 ------------------ extra/ui/frp/gadgets/summary.txt | 1 - extra/ui/frp/signals/signals-docs.factor | 49 ----------- extra/ui/frp/signals/summary.txt | 1 - extra/ui/gadgets/alerts/alerts.factor | 10 +-- extra/ui/gadgets/comboboxes/comboboxes.factor | 11 +-- .../layout => gadgets/controls}/authors.txt | 0 .../controls/controls-docs.factor} | 52 +++++------ extra/ui/gadgets/controls/controls.factor | 87 +++++++++++++++++++ extra/ui/gadgets/controls/summary.txt | 1 + .../signals => gadgets/layout}/authors.txt | 0 .../layout/layout-docs.factor | 14 +-- .../ui/{frp => gadgets}/layout/layout.factor | 28 +++--- extra/ui/{frp => gadgets}/layout/summary.txt | 0 23 files changed, 255 insertions(+), 257 deletions(-) rename extra/{ui/frp/gadgets => models/combinators}/authors.txt (100%) create mode 100644 extra/models/combinators/combinators-docs.factor rename extra/{ui/frp/signals/signals.factor => models/combinators/combinators.factor} (77%) create mode 100644 extra/models/combinators/summary.txt rename extra/{ui/frp/signals => models/combinators}/templates/templates.factor (89%) delete mode 100644 extra/ui/frp/gadgets/gadgets.factor delete mode 100644 extra/ui/frp/gadgets/summary.txt delete mode 100644 extra/ui/frp/signals/signals-docs.factor delete mode 100644 extra/ui/frp/signals/summary.txt rename extra/ui/{frp/layout => gadgets/controls}/authors.txt (100%) rename extra/ui/{frp/gadgets/gadgets-docs.factor => gadgets/controls/controls-docs.factor} (64%) create mode 100644 extra/ui/gadgets/controls/controls.factor create mode 100644 extra/ui/gadgets/controls/summary.txt rename extra/ui/{frp/signals => gadgets/layout}/authors.txt (100%) rename extra/ui/{frp => gadgets}/layout/layout-docs.factor (84%) rename extra/ui/{frp => gadgets}/layout/layout.factor (74%) rename extra/ui/{frp => gadgets}/layout/summary.txt (100%) diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor index adfb7d67de..b253ef0c96 100644 --- a/extra/file-trees/file-trees.factor +++ b/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 ; : ( tree-model -- table ) - [ node>> 1array ] >>quot - [ selected-value>> [ file? not ] swap ] + [ node>> 1array ] >>quot + [ selected-value>> [ file? not ] filter-model swap switch-models ] [ swap >>model ] bi ; \ No newline at end of file diff --git a/extra/ui/frp/gadgets/authors.txt b/extra/models/combinators/authors.txt similarity index 100% rename from extra/ui/frp/gadgets/authors.txt rename to extra/models/combinators/authors.txt diff --git a/extra/models/combinators/combinators-docs.factor b/extra/models/combinators/combinators-docs.factor new file mode 100644 index 0000000000..5ccfe1f758 --- /dev/null +++ b/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: +{ $values { "model" model } { "quot" "applied to model's value on updates" } { "model" model } } +{ $description "An expanded version of " { $link } ". 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" \ No newline at end of file diff --git a/extra/ui/frp/signals/signals.factor b/extra/models/combinators/combinators.factor similarity index 77% rename from extra/ui/frp/signals/signals.factor rename to extra/models/combinators/combinators.factor index 681ffafeae..c7b864d404 100644 --- a/extra/ui/frp/signals/signals.factor +++ b/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 ; -: ( models -- signal ) basic-model ; -: <2merge> ( model1 model2 -- signal ) 2array ; -: ( value -- signal ) basic-model new-model ; +: merge ( models -- model ) basic-model ; +: 2merge ( model1 model2 -- model ) 2array merge ; +: ( 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 ; -: ( model quot -- filter-signal ) [ 1array filter-model ] dip >>quot ; +: filter-model ( model quot -- filter-model ) [ 1array \ filter-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 V{ } clone >>values ; -: ( 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 ; -: ( 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) ; -: ( values updates -- signal ) [ 2array updater-model ] 2keep +: updates ( values updates -- model ) [ 2array updater-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 ; -: ( signal1 signal2 -- signal' ) swap [ 2array switch-model ] 2keep +: switch-models ( model1 model2 -- model' ) swap [ 2array switch-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 swap >>quot swap >>model ; -: ( model quot -- signal ) mapped-model new-mapped-model ; +: ( 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 ; -: ( model quot -- action-signal ) [ 1array action ] dip >>quot dup f >>value value>> ; +: ( model quot -- action-model ) [ 1array action ] dip >>quot dup f >>value value>> ; TUPLE: collection < multi-model ; : ( models -- product ) collection ; @@ -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) 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) 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 dup ] dip call swap [ add-dependency ] keep ; inline -USE: ui.frp.signals.templates +USE: models.combinators.templates << { "$>" "<$" "fmap" } [ fmaps ] each >> \ No newline at end of file diff --git a/extra/models/combinators/summary.txt b/extra/models/combinators/summary.txt new file mode 100644 index 0000000000..1e5347e3fd --- /dev/null +++ b/extra/models/combinators/summary.txt @@ -0,0 +1 @@ +Model combination and manipulation \ No newline at end of file diff --git a/extra/ui/frp/signals/templates/templates.factor b/extra/models/combinators/templates/templates.factor similarity index 89% rename from extra/ui/frp/signals/templates/templates.factor rename to extra/models/combinators/templates/templates.factor index bb08e03ea3..685ad93774 100644 --- a/extra/ui/frp/signals/templates/templates.factor +++ b/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 => #1 ; +IN: models.combinators.templates +FROM: models.combinators => #1 ; FUNCTOR: fmaps ( W -- ) W IS ${W} w-n DEFINES ${W}-n diff --git a/extra/modules/rpc-server/rpc-server.factor b/extra/modules/rpc-server/rpc-server.factor index ffc2e404db..cb7e652a39 100644 --- a/extra/modules/rpc-server/rpc-server.factor +++ b/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 \ No newline at end of file diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor index 528663d370..a99e65cf5c 100644 --- a/extra/recipes/recipes.factor +++ b/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 } } ; : ( title genre text -- recipe ) recipe new swap >>txt swap >>genre swap >>title 0 >>votes ; -get-psql-info recipe define-db +"recipes.db" temp-file recipe define-db : top-recipes ( offset search -- recipes ) 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 $ ] , - ] { 350 245 } >>pref-dim ; + ] { 350 245 } >>pref-dim ; :: recipe-browser ( -- ) [ [ interface - :> tbl - "okay" 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 :> votes - IMG-FRP-BTN: back -> [ -30 ] <$ - IMG-FRP-BTN: more -> [ 30 ] <$ 2array :> viewed - ->% 1 :> search - submit ok [ [ drop ] ] <$ 2array [ drop ] >>value :> quot - viewed 0 [ + ] search ok t "all" ALL -> + :> tbl + "okay" 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 + ->% 1 :> search + submit ok [ [ drop ] ] <$ 2array merge [ drop ] >>value :> quot + viewed 0 [ + ] fold search ok t "all" ALL -> tbl selected-value>> votes [ [ + ] curry change-votes modify-tuple ] 2$> - 4array - [ drop [ f ] [ "%" dup surround ] if-empty top-recipes ] 3fmap :> updates - updates [ top-genres [ GENRES -> ] map ] bind* + 4array merge + [ drop [ f ] [ "%" dup surround ] if-empty top-recipes ] 3fmap :> ups + ups [ top-genres [ GENRES -> ] map merge ] bind* [ text>> T{ recipe } swap >>genre get-tuples ] fmap - tbl swap updates 2array >>model + tbl swap ups 2merge >>model [ [ title>> ] [ genre>> ] bi 2array ] >>quot { "Title" "Genre" } >>column-titles dup RECIPES ,% 1 actions>> - submit [ "" dup dup ] <$ 2array - { [ [ title>> ] fmap TITLE ->% .5 ] - [ [ genre>> ] fmap GENRE ->% .5 ] - [ [ txt>> ] fmap BODY ->% 1 ] + submit [ "" dup dup ] <$ 2array merge + { [ [ title>> ] fmap TITLE ->% .5 ] + [ [ genre>> ] fmap GENRE ->% .5 ] + [ [ txt>> ] fmap BODY ->% 1 ] } cleave [ ] 3fmap [ [ 1 ] <$ ] - [ quot ok #1 [ call( recipe -- ) 0 ] 2fmap ] bi - 2array 0 >>model + [ quot ok updates #1 [ call( recipe -- ) 0 ] 2fmap ] bi + 2merge 0 switch-models >>model ] with-interface "recipes" open-window ] with-ui ; MAIN: recipe-browser \ No newline at end of file diff --git a/extra/sudokus/sudokus.factor b/extra/sudokus/sudokus.factor index efc127f2a5..9de9a6fe7c 100644 --- a/extra/sudokus/sudokus.factor +++ b/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 [ [ ] map 9 group [ 3 group ] map 3 group - [ [ [ [ [ ->% 2 [ string>number ] fmap ] + 81 [ "" ] replicate switch-models [ [ ] map 9 group [ 3 group ] map 3 group + [ [ [ [ [ ->% 2 [ string>number ] fmap ] map ] map concat ] , ] map concat ] map concat - [ "Difficulty:"