From 91e8e9522c60698caec955875d289dc40e21f6e1 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sat, 2 May 2009 08:22:14 -0500 Subject: [PATCH 1/6] str-fry can take non-literals --- extra/str-fry/str-fry.factor | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/extra/str-fry/str-fry.factor b/extra/str-fry/str-fry.factor index aafdaa95d9..65e25e2580 100644 --- a/extra/str-fry/str-fry.factor +++ b/extra/str-fry/str-fry.factor @@ -1,4 +1,7 @@ -USING: kernel sequences splitting strings.parser ; +USING: fry.private kernel macros math sequences splitting strings.parser ; IN: str-fry -: str-fry ( str -- quot ) "_" split unclip [ [ rot glue ] reduce ] 2curry ; +: str-fry ( str -- quot ) "_" split + [ length 1 - [ncurry] [ call ] append ] + [ unclip [ [ rot glue ] reduce ] 2curry ] bi + prefix ; SYNTAX: I" parse-string rest str-fry over push-all ; \ No newline at end of file From 06359c08507fc844b2857f48a818ce79c4155d9c Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sat, 2 May 2009 10:32:18 -0500 Subject: [PATCH 2/6] str-fry fixes --- extra/str-fry/str-fry.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/str-fry/str-fry.factor b/extra/str-fry/str-fry.factor index 65e25e2580..bfe74f37eb 100644 --- a/extra/str-fry/str-fry.factor +++ b/extra/str-fry/str-fry.factor @@ -1,7 +1,7 @@ -USING: fry.private kernel macros math sequences splitting strings.parser ; +USING: combinators effects kernel math sequences splitting +strings.parser ; IN: str-fry : str-fry ( str -- quot ) "_" split - [ length 1 - [ncurry] [ call ] append ] - [ unclip [ [ rot glue ] reduce ] 2curry ] bi - prefix ; + [ unclip [ [ rot glue ] reduce ] 2curry ] + [ length 1 - 1 [ call-effect ] 2curry ] bi ; SYNTAX: I" parse-string rest str-fry over push-all ; \ No newline at end of file From bd92f6c8ccb04c563b4425a0c62f01199096459d Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sun, 3 May 2009 11:48:28 -0500 Subject: [PATCH 3/6] separated behaviors and events in frp --- extra/ui/frp/frp.factor | 31 +++++++++++++++++++++---------- 1 file changed, 21 insertions(+), 10 deletions(-) diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor index aa7c44ee03..f972a3f805 100644 --- a/extra/ui/frp/frp.factor +++ b/extra/ui/frp/frp.factor @@ -1,7 +1,7 @@ -USING: accessors arrays colors fonts fry kernel models +USING: accessors arrays colors fonts kernel models models.product monads sequences ui.gadgets ui.gadgets.buttons ui.gadgets.editors ui.gadgets.line-support ui.gadgets.tables -ui.gadgets.tracks ui.render ; +ui.gadgets.tracks ui.render ui.gadgets.scrollers ; QUALIFIED: make IN: ui.frp @@ -27,6 +27,8 @@ M: frp-table row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ; GENERIC: output-model ( gadget -- model ) M: gadget output-model model>> ; M: frp-table output-model selected-value>> ; +M: model-field output-model field-model>> ; +M: scroller output-model children>> first model>> ; GENERIC: , ( uiitem -- ) M: gadget , make:, ; @@ -41,13 +43,16 @@ M: table -> dup , selected-value>> ; [ { } make:make ] dip swap [ f track-add ] each ; inline : ( gadgets type -- track ) [ ] [ [ model>> ] map ] bi >>model ; inline : ( gadgets -- track ) horizontal ; inline +: ( gadgets -- track ) horizontal ; inline : ( gadgets -- track ) vertical ; inline +: ( gadgets -- track ) vertical ; inline -! Model utilities +! !!! Model utilities TUPLE: multi-model < model ; -! M: multi-model model-activated dup model-changed ; : ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ; +! Events- discrete model utilities + TUPLE: merge-model < multi-model ; M: merge-model model-changed [ value>> ] dip set-model ; : ( models -- model ) merge-model ; @@ -57,15 +62,21 @@ M: filter-model model-changed [ value>> ] dip [ quot>> call( val -- bool ) ] 2ke [ set-model ] [ 2drop ] if ; : ( model quot -- filter-model ) [ 1array filter-model ] dip >>quot ; +! Behaviors - continuous model utilities + TUPLE: fold-model < multi-model oldval quot ; M: fold-model model-changed [ [ value>> ] [ [ oldval>> ] [ quot>> ] bi ] bi* call( val oldval -- newval ) ] keep set-model ; -: ( oldval quot model -- model' ) 1array fold-model swap >>quot swap >>oldval ; +: ( oldval quot model -- model' ) 1array fold-model swap >>quot + swap [ >>oldval ] [ >>value ] bi ; -TUPLE: switch-model < multi-model switcher on ; -M: switch-model model-changed tuck [ switcher>> = ] 2keep - '[ on>> [ _ value>> _ set-model ] when ] [ t swap (>>on) ] if ; -: switch ( signal1 signal2 -- signal' ) [ 2array switch-model ] keep >>switcher ; +TUPLE: switch-model < multi-model original switcher on ; +M: switch-model model-changed 2dup switcher>> = + [ [ value>> ] [ t >>on ] bi* set-model ] + [ dup on>> [ 2drop ] [ [ value>> ] dip set-model ] if ] if ; +M: switch-model model-activated [ original>> ] keep model-changed ; +: switch ( signal1 signal2 -- signal' ) [ 2array switch-model ] 2keep + [ >>original ] [ >>switcher ] bi* ; TUPLE: mapped < model model quot ; @@ -87,4 +98,4 @@ INSTANCE: gadget-monad monad INSTANCE: gadget monad M: gadget monad-of drop gadget-monad ; M: gadget-monad return drop swap >>model ; -M: gadget >>= model>> '[ _ swap call( x -- y ) ] ; \ No newline at end of file +M: gadget >>= output-model [ swap call( x -- y ) ] curry ; \ No newline at end of file From 6fc5e7a75452a81f0f566929e403c8f9f0113d9b Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sun, 3 May 2009 12:14:17 -0500 Subject: [PATCH 4/6] frp: switcher ignores f values --- extra/ui/frp/frp-docs.factor | 2 +- extra/ui/frp/frp.factor | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/extra/ui/frp/frp-docs.factor b/extra/ui/frp/frp-docs.factor index af44567e46..479a56e513 100644 --- a/extra/ui/frp/frp-docs.factor +++ b/extra/ui/frp/frp-docs.factor @@ -36,7 +36,7 @@ HELP: { $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 +HELP: { $values { "signal1" model } { "signal2" model } { "signal'" model } } { $description "Creates a model that starts with the behavior of model1 and switches to the behavior of model2 on its update" } ; diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor index f972a3f805..6b146c8296 100644 --- a/extra/ui/frp/frp.factor +++ b/extra/ui/frp/frp.factor @@ -20,6 +20,8 @@ M: frp-table row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ; focus-border-color >>focus-border-color transparent >>column-line-color ; : ( model -- table ) [ 1array ] >>quot ; +: ( -- table ) f ; + : ( -- field ) f ; ! Layout utilities @@ -72,10 +74,10 @@ M: fold-model model-changed [ [ value>> ] [ [ oldval>> ] [ quot>> ] bi ] bi* TUPLE: switch-model < multi-model original switcher on ; M: switch-model model-changed 2dup switcher>> = - [ [ value>> ] [ t >>on ] bi* set-model ] + [ over value>> [ [ value>> ] [ t >>on ] bi* set-model ] [ 2drop ] if ] [ dup on>> [ 2drop ] [ [ value>> ] dip set-model ] if ] if ; M: switch-model model-activated [ original>> ] keep model-changed ; -: switch ( signal1 signal2 -- signal' ) [ 2array switch-model ] 2keep +: ( signal1 signal2 -- signal' ) [ 2array switch-model ] 2keep [ >>original ] [ >>switcher ] bi* ; TUPLE: mapped < model model quot ; From 7d020d8f2f8e6a1ad579634d177c4a9f3cfa7f33 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sun, 3 May 2009 12:29:12 -0500 Subject: [PATCH 5/6] frp: set default val-quot --- extra/ui/frp/frp.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor index 6b146c8296..699d034c72 100644 --- a/extra/ui/frp/frp.factor +++ b/extra/ui/frp/frp.factor @@ -18,7 +18,8 @@ M: frp-table row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ; frp-table new-line-gadget dup >>renderer [ ] >>quot swap >>model f >>selected-value sans-serif-font >>font focus-border-color >>focus-border-color - transparent >>column-line-color ; + transparent >>column-line-color [ ] >>val-quot ; +: ( -- table ) f ; : ( model -- table ) [ 1array ] >>quot ; : ( -- table ) f ; From 0ca6a6c63f195c7326baac282ebaa12d67abe595 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sun, 3 May 2009 12:29:29 -0500 Subject: [PATCH 6/6] added gui for file-trees --- extra/file-trees/file-trees.factor | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor index 788291c0a2..eadfccdc4c 100644 --- a/extra/file-trees/file-trees.factor +++ b/extra/file-trees/file-trees.factor @@ -1,10 +1,10 @@ -USING: accessors delegate delegate.protocols io.pathnames -kernel locals namespaces sequences vectors -tools.annotations prettyprint ; +USING: accessors arrays delegate delegate.protocols +io.pathnames kernel locals namespaces prettyprint sequences +ui.frp vectors ; IN: file-trees TUPLE: tree node children ; -CONSULT: sequence-protocol tree children>> [ node>> ] map ; +CONSULT: sequence-protocol tree children>> ; : ( start -- tree ) V{ } clone [ tree boa dup children>> ] [ ".." swap tree boa ] bi swap push ; @@ -20,4 +20,9 @@ DEFER: (tree-insert) path-rest [ path-head tree-insert ] unless-empty ] if* ; : create-tree ( file-list -- tree ) [ path-components ] map - t [ [ tree-insert ] curry each ] keep ; \ No newline at end of file + t [ [ tree-insert ] curry each ] keep ; + +: ( tree-model -- table ) + [ node>> 1array ] >>quot + [ selected-value>> ] + [ swap >>model ] bi ; \ No newline at end of file