! Copyright (C) 2005, 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel kernel.private locals slots.private math
+USING: accessors kernel kernel.private slots.private math
math.private math.order ;
IN: sequences
<PRIVATE
+: ((each)) ( seq -- n quot )
+ [ length ] keep [ nth-unsafe ] curry ; inline
+
: (each) ( seq quot -- n quot' )
- [ [ length ] keep [ nth-unsafe ] curry ] dip compose ; inline
+ [ ((each)) ] dip compose ; inline
+
+: (each-index) ( seq quot -- n quot' )
+ [ ((each)) [ keep ] curry ] dip compose ; inline
: (collect) ( quot into -- quot' )
[ [ keep ] dip set-nth-unsafe ] 2curry ; inline
: follow ( obj quot -- seq )
[ dup ] swap [ keep ] curry produce nip ; inline
-: prepare-index ( seq quot -- seq n quot )
- [ dup length ] dip ; inline
-
: each-index ( seq quot -- )
- prepare-index 2each ; inline
+ (each-index) each-integer ; inline
: interleave ( seq between quot -- )
- swap [ drop ] [ [ 2dip call ] 2curry ] 2bi
- [ [ 0 = ] 2dip if ] 2curry
- each-index ; inline
+ pick empty? [ 3drop ] [
+ [ [ drop first-unsafe ] dip call ]
+ [ [ rest-slice ] 2dip [ bi* ] 2curry each ]
+ 3bi
+ ] if ; inline
: map-index ( seq quot -- newseq )
- prepare-index 2map ; inline
+ [ dup length iota ] dip 2map ; inline
: reduce-index ( seq identity quot -- )
swapd each-index ; inline
[ array-flip ] [ generic-flip ] if
] [ generic-flip ] if
] unless ;
-
-: 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
-
-:: 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
\ No newline at end of file
combinators vectors splitting continuations math
parser.notes ;
IN: vocabs.parser
-
+
ERROR: no-word-error name ;
: word-restarts ( possibilities -- restarts )
word-restarts
swap "Defer word in current vocabulary" swap 2array
suffix ;
-
+
: <no-word-error> ( name possibilities -- error restarts )
[ drop \ no-word-error boa ] [ word-restarts-with-defer ] 2bi ;
2dup qualified-search dup [ 2nip ] [ drop vocab-search ] if ;
: search ( name -- word/f )
- manifest get search-manifest ;
\ No newline at end of file
+ manifest get search-manifest ;
USING: accessors arrays db.tuples db.sqlite persistency db.queries
io.files.temp kernel monads sequences ui ui.frp.gadgets
ui.frp.layout ui.frp.signals ui.gadgets.scrollers ui.gadgets.labels
-colors.constants ui.pens.solid combinators math locals strings fries
+colors.constants ui.pens.solid combinators math locals strings
ui.images db.types ;
FROM: sets => prune ;
IN: recipes
: 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) ;
-: <image-button> ( str -- button ) i" vocab:recipes/icons/_.tiff" <image-name> <frp-button> ;
+: <image-button> ( str -- button ) "vocab:recipes/icons/" ".tiff" surround <image-name> <frp-button> ;
: interface ( -- book ) [
[
TUPLE: frp-button < button hook value ;
: <frp-button> ( gadget -- button ) [
+ [ dup hook>> [ call( button -- ) ] [ drop ] if* ]
[ [ [ value>> ] [ ] bi or ] keep set-control-value ]
- [ dup hook>> [ call( button -- ) ] [ drop ] if* ] bi
+ [ model>> f swap (>>value) ] tri
] frp-button new-button f <basic> >>model ;
: <frp-border-button> ( text -- button ) <frp-button> border-button-theme ;