Merge branch 'master' of git://factorcode.org/git/factor

db4
William Schlieper 2008-07-15 02:49:04 -04:00
commit 416f002220
17 changed files with 58 additions and 120 deletions

View File

@ -11,7 +11,7 @@ HELP: 1token
} { $description } { $description
"Calls 1string on a character and returns a parser that matches that character." "Calls 1string on a character and returns a parser that matches that character."
} { $examples } { $examples
{ $example "USING: peg peg.parsers prettyprint ;" "\"a\" CHAR: a 1token parse parse-result-ast ." "\"a\"" } { $example "USING: peg peg.parsers prettyprint ;" "\"a\" CHAR: a 1token parse ." "\"a\"" }
} { $see-also 'string' } ; } { $see-also 'string' } ;
HELP: (list-of) HELP: (list-of)
@ -33,8 +33,8 @@ HELP: list-of
"Returns a parser that returns a list of items separated by the separator parser. Hides the separators and matches a list of one or more items." "Returns a parser that returns a list of items separated by the separator parser. Hides the separators and matches a list of one or more items."
} { $notes "Use " { $link list-of-many } " to ensure a list contains two or more items." } } { $notes "Use " { $link list-of-many } " to ensure a list contains two or more items." }
{ $examples { $examples
{ $example "USING: peg peg.parsers prettyprint ;" "\"a\" \"a\" token \",\" token list-of parse parse-result-ast ." "V{ \"a\" }" } { $example "USING: peg peg.parsers prettyprint ;" "\"a\" \"a\" token \",\" token list-of parse ." "V{ \"a\" }" }
{ $example "USING: peg peg.parsers prettyprint ;" "\"a,a,a,a\" \"a\" token \",\" token list-of parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" } { $example "USING: peg peg.parsers prettyprint ;" "\"a,a,a,a\" \"a\" token \",\" token list-of parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
} { $see-also list-of-many } ; } { $see-also list-of-many } ;
HELP: list-of-many HELP: list-of-many
@ -46,8 +46,8 @@ HELP: list-of-many
"Returns a parser that returns a list of items separated by the separator parser. Hides the separators and matches a list of two or more items." "Returns a parser that returns a list of items separated by the separator parser. Hides the separators and matches a list of two or more items."
} { $notes "Use " { $link list-of } " to return a list of only one item." } { $notes "Use " { $link list-of } " to return a list of only one item."
} { $examples } { $examples
{ $example "USING: peg peg.parsers prettyprint ;" "\"a\" \"a\" token \",\" token list-of-many parse ." "f" } { $code "USING: peg peg.parsers prettyprint ;" "\"a\" \"a\" token \",\" token list-of-many parse => exception" }
{ $example "USING: peg peg.parsers prettyprint ;" "\"a,a,a,a\" \"a\" token \",\" token list-of-many parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" } { $example "USING: peg peg.parsers prettyprint ;" "\"a,a,a,a\" \"a\" token \",\" token list-of-many parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
} { $see-also list-of } ; } { $see-also list-of } ;
HELP: epsilon HELP: epsilon
@ -72,8 +72,8 @@ HELP: exactly-n
} { $description } { $description
"Returns a parser that matches an exact repetition of the input parser." "Returns a parser that matches an exact repetition of the input parser."
} { $examples } { $examples
{ $example "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 4 exactly-n parse ." "f" } { $code "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 4 exactly-n parse => exception" }
{ $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 exactly-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" } { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 exactly-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
} { $see-also at-least-n at-most-n from-m-to-n } ; } { $see-also at-least-n at-most-n from-m-to-n } ;
HELP: at-least-n HELP: at-least-n
@ -84,9 +84,9 @@ HELP: at-least-n
} { $description } { $description
"Returns a parser that matches n or more repetitions of the input parser." "Returns a parser that matches n or more repetitions of the input parser."
} { $examples } { $examples
{ $example "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 4 at-least-n parse ." "f" } { $code "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 4 at-least-n parse => exception"}
{ $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 at-least-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" } { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 at-least-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
{ $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 4 at-least-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" \"a\" }" } { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 4 at-least-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" \"a\" }" }
} { $see-also exactly-n at-most-n from-m-to-n } ; } { $see-also exactly-n at-most-n from-m-to-n } ;
HELP: at-most-n HELP: at-most-n
@ -97,8 +97,8 @@ HELP: at-most-n
} { $description } { $description
"Returns a parser that matches n or fewer repetitions of the input parser." "Returns a parser that matches n or fewer repetitions of the input parser."
} { $examples } { $examples
{ $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 at-most-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" } { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 at-most-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
{ $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 4 at-most-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" } { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 4 at-most-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
} { $see-also exactly-n at-least-n from-m-to-n } ; } { $see-also exactly-n at-least-n from-m-to-n } ;
HELP: from-m-to-n HELP: from-m-to-n
@ -110,9 +110,9 @@ HELP: from-m-to-n
} { $description } { $description
"Returns a parser that matches between and including m to n repetitions of the input parser." "Returns a parser that matches between and including m to n repetitions of the input parser."
} { $examples } { $examples
{ $example "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 3 4 from-m-to-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" }" } { $example "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 3 4 from-m-to-n parse ." "V{ \"a\" \"a\" \"a\" }" }
{ $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 3 4 from-m-to-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" } { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 3 4 from-m-to-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
{ $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 3 4 from-m-to-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" } { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 3 4 from-m-to-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
} { $see-also exactly-n at-most-n at-least-n } ; } { $see-also exactly-n at-most-n at-least-n } ;
HELP: pack HELP: pack
@ -124,7 +124,7 @@ HELP: pack
} { $description } { $description
"Returns a parser that parses the begin, body, and end parsers in order. The begin and end parsers are hidden." "Returns a parser that parses the begin, body, and end parsers in order. The begin and end parsers are hidden."
} { $examples } { $examples
{ $example "USING: peg peg.parsers prettyprint ;" "\"hi123bye\" \"hi\" token 'integer' \"bye\" token pack parse parse-result-ast ." "123" } { $example "USING: peg peg.parsers prettyprint ;" "\"hi123bye\" \"hi\" token 'integer' \"bye\" token pack parse ." "123" }
} { $see-also surrounded-by } ; } { $see-also surrounded-by } ;
HELP: surrounded-by HELP: surrounded-by
@ -136,7 +136,7 @@ HELP: surrounded-by
} { $description } { $description
"Calls token on begin and end to make them into string parsers. Returns a parser that parses the begin, body, and end parsers in order. The begin and end parsers are hidden." "Calls token on begin and end to make them into string parsers. Returns a parser that parses the begin, body, and end parsers in order. The begin and end parsers are hidden."
} { $examples } { $examples
{ $example "USING: peg peg.parsers prettyprint ;" "\"hi123bye\" 'integer' \"hi\" \"bye\" surrounded-by parse parse-result-ast ." "123" } { $example "USING: peg peg.parsers prettyprint ;" "\"hi123bye\" 'integer' \"hi\" \"bye\" surrounded-by parse ." "123" }
} { $see-also pack } ; } { $see-also pack } ;
HELP: 'digit' HELP: 'digit'
@ -173,7 +173,7 @@ HELP: range-pattern
"of characters separated with a dash (-) represents the " "of characters separated with a dash (-) represents the "
"range of characters from the first to the second, inclusive." "range of characters from the first to the second, inclusive."
{ $examples { $examples
{ $example "USING: peg peg.parsers prettyprint strings ;" "\"a\" \"_a-zA-Z\" range-pattern parse parse-result-ast 1string ." "\"a\"" } { $example "USING: peg peg.parsers prettyprint strings ;" "\"a\" \"_a-zA-Z\" range-pattern parse 1string ." "\"a\"" }
{ $example "USING: peg peg.parsers prettyprint ;\n\"0\" \"^0-9\" range-pattern parse ." "f" } { $code "USING: peg peg.parsers prettyprint ;\n\"0\" \"^0-9\" range-pattern parse => exception"}
} }
} ; } ;

View File

@ -7,11 +7,11 @@ HELP: parse
{ $values { $values
{ "input" "a string" } { "input" "a string" }
{ "parser" "a parser" } { "parser" "a parser" }
{ "result" "a parse-result or f" } { "ast" "an object" }
} }
{ $description { $description
"Given the input string, parse it using the given parser. The result is a <parse-result> object if " "Given the input string, parse it using the given parser. The result is the abstract "
"the parse was successful, otherwise it is f." } "syntax tree returned by the parser." }
{ $see-also compile } ; { $see-also compile } ;
HELP: compile HELP: compile
@ -20,7 +20,7 @@ HELP: compile
{ "word" "a word" } { "word" "a word" }
} }
{ $description { $description
"Compile the parser to a word. The word will have stack effect ( -- result )." "Compile the parser to a word. The word will have stack effect ( -- ast )."
} }
{ $see-also parse } ; { $see-also parse } ;
@ -104,8 +104,7 @@ HELP: semantic
"Returns a parser that succeeds if the 'p1' parser succeeds and the quotation called with " "Returns a parser that succeeds if the 'p1' parser succeeds and the quotation called with "
"the AST produced by 'p1' on the stack returns true." } "the AST produced by 'p1' on the stack returns true." }
{ $examples { $examples
{ $example "USING: kernel math peg prettyprint ;" "\"A\" [ drop t ] satisfy [ 66 > ] semantic parse ." "f" } { $example "USING: kernel math peg prettyprint ;" "\"C\" [ drop t ] satisfy [ 66 > ] semantic parse ." "67" }
{ $example "USING: kernel math peg prettyprint ;" "\"C\" [ drop t ] satisfy [ 66 > ] semantic parse parse-result-ast ." "67" }
} ; } ;
HELP: ensure HELP: ensure

View File

@ -8,7 +8,6 @@ ARTICLE: "ui-frame-layout" "Frame layouts"
"Creating empty frames:" "Creating empty frames:"
{ $subsection <frame> } { $subsection <frame> }
"Creating new frames using a combinator:" "Creating new frames using a combinator:"
{ $subsection make-frame }
{ $subsection frame, } { $subsection frame, }
"A set of mnemonic words for the positions on a frame's 3x3 grid; these words push values which may be passed to " { $link grid-add } " or " { $link frame, } ":" "A set of mnemonic words for the positions on a frame's 3x3 grid; these words push values which may be passed to " { $link grid-add } " or " { $link frame, } ":"
{ $subsection @center } { $subsection @center }
@ -44,15 +43,9 @@ HELP: <frame>
{ $values { "frame" frame } } { $values { "frame" frame } }
{ $description "Creates a new " { $link frame } " for laying out gadgets in a 3x3 grid." } ; { $description "Creates a new " { $link frame } " for laying out gadgets in a 3x3 grid." } ;
{ <frame> make-frame } related-words
HELP: make-frame
{ $values { "quot" quotation } { "frame" frame } }
{ $description "Creates a new frame. The quotation can add children by calling the " { $link frame, } " word." } ;
HELP: frame, HELP: frame,
{ $values { "gadget" gadget } { "i" "non-negative integer" } { "j" "non-negative integer" } } { $values { "gadget" gadget } { "i" "non-negative integer" } { "j" "non-negative integer" } }
{ $description "Adds a child gadget at the specified location. This word can only be called inside the quotation passed to " { $link make-frame } "." } ; { $description "Adds a child gadget at the specified location. This word can only be called inside the quotation passed to make-frame." } ;
{ grid frame } related-words { grid frame } related-words

View File

@ -39,8 +39,5 @@ M: frame layout*
[ rot rect-dim fill-center ] 3keep [ rot rect-dim fill-center ] 3keep
grid-layout ; grid-layout ;
: make-frame ( quot -- frame )
<frame> swap make-gadget ; inline
: frame, ( gadget i j -- ) : frame, ( gadget i j -- )
gadget get -rot grid-add ; gadget get -rot grid-add ;

View File

@ -180,14 +180,6 @@ HELP: focusable-child
{ $values { "gadget" gadget } { "child" gadget } } { $values { "gadget" gadget } { "child" gadget } }
{ $description "Outputs the child of the gadget which would prefer to receive keyboard focus." } ; { $description "Outputs the child of the gadget which would prefer to receive keyboard focus." } ;
HELP: make-gadget
{ $values { "gadget" gadget } { "quot" quotation } }
{ $description "Calls the quotation in a new scope with the gadget stored in the " { $link gadget } " variable." } ;
HELP: with-gadget
{ $values { "gadget" gadget } { "quot" quotation } }
{ $description "Calls the quotation in a new scope with the " { $link gadget } " and " { $link make-gadget } " variables set to " { $snippet "gadget" } } ;
{ control-value set-control-value gadget-model } related-words { control-value set-control-value gadget-model } related-words
HELP: control-value HELP: control-value

View File

@ -357,12 +357,6 @@ M: f request-focus-on 2drop ;
: focus-path ( world -- seq ) : focus-path ( world -- seq )
[ focus>> ] follow ; [ focus>> ] follow ;
: with-gadget ( gadget quot -- )
gadget swap with-variable ; inline
: make-gadget ( gadget quot -- gadget )
[ with-gadget ] [ drop ] 2bi ; inline
! Deprecated ! Deprecated
: set-gadget-delegate ( gadget tuple -- ) : set-gadget-delegate ( gadget tuple -- )
over [ over [

View File

@ -38,10 +38,9 @@ M: labelled-gadget focusable-child* labelled-gadget-content ;
: <title-label> ( text -- label ) <label> dup title-theme ; : <title-label> ( text -- label ) <label> dup title-theme ;
: <title-bar> ( title quot -- gadget ) : <title-bar> ( title quot -- gadget )
[ <frame>
[ <close-box> @left frame, ] when* swap dup [ <close-box> @left grid-add* ] [ drop ] if
<title-label> @center frame, swap <title-label> @center grid-add* ;
] make-frame ;
TUPLE: closable-gadget < frame content ; TUPLE: closable-gadget < frame content ;

View File

@ -64,7 +64,11 @@ M: object >label ;
M: f >label drop <gadget> ; M: f >label drop <gadget> ;
: label-on-left ( gadget label -- button ) : label-on-left ( gadget label -- button )
[ >label f track, 1 track, ] { 1 0 } make-track ; { 1 0 } <track>
swap >label f track-add*
swap 1 track-add* ;
: label-on-right ( label gadget -- button ) : label-on-right ( label gadget -- button )
[ f track, >label 1 track, ] { 1 0 } make-track ; { 1 0 } <track>
swap f track-add*
swap >label 1 track-add* ;

View File

@ -9,9 +9,6 @@ ARTICLE: "ui-pack-layout" "Pack layouts"
{ $subsection <pack> } { $subsection <pack> }
{ $subsection <pile> } { $subsection <pile> }
{ $subsection <shelf> } { $subsection <shelf> }
"Creating packs using a combinator:"
{ $subsection make-filled-pile }
{ $subsection make-shelf }
"For more control, custom layouts can reuse portions of pack layout logic:" "For more control, custom layouts can reuse portions of pack layout logic:"
{ $subsection pack-pref-dim } { $subsection pack-pref-dim }
@ -23,8 +20,6 @@ HELP: pack
{ $link <pack> } { $link <pack> }
{ $link <pile> } { $link <pile> }
{ $link <shelf> } { $link <shelf> }
{ $link make-filled-pile }
{ $link make-shelf }
} }
"Packs have the following slots:" "Packs have the following slots:"
{ $list { $list
@ -62,12 +57,4 @@ HELP: pack-pref-dim
"This word is useful if you are writing your own layout gadget which inherits from " { $link pack } ". This allows you to reuse layout logic while computing gadget sizes using a custom procedure." "This word is useful if you are writing your own layout gadget which inherits from " { $link pack } ". This allows you to reuse layout logic while computing gadget sizes using a custom procedure."
} ; } ;
HELP: make-filled-pile
{ $values { "quot" quotation } { "pack" "a new " { $link pack } } }
{ $description "Creates a new " { $link pack } " which lays out a sequence of gadgets vertically, such that all gadgets have the same width. The quotation can add children by calling the gadget, word." } ;
HELP: make-shelf
{ $values { "quot" quotation } { "pack" "a new " { $link pack } } }
{ $description "Creates a new " { $link pack } " which lays out a sequence of gadgets horizontally. The quotation can add children by calling the gadget, word." } ;
ABOUT: "ui-pack-layout" ABOUT: "ui-pack-layout"

View File

@ -60,9 +60,3 @@ M: pack layout*
M: pack children-on ( rect gadget -- seq ) M: pack children-on ( rect gadget -- seq )
dup gadget-orientation swap gadget-children dup gadget-orientation swap gadget-children
[ fast-children-on ] keep <slice> ; [ fast-children-on ] keep <slice> ;
: make-filled-pile ( quot -- pack )
<filled-pile> swap make-gadget ; inline
: make-shelf ( quot -- pack )
<shelf> swap make-gadget ; inline

View File

@ -96,8 +96,10 @@ TUPLE: editable-slot < track printer ref ;
<roll-button> ; <roll-button> ;
: display-slot ( gadget editable-slot -- ) : display-slot ( gadget editable-slot -- )
dup clear-track dup clear-track
[ 1 track, <edit-button> f track, ] with-gadget ; swap 1 track-add*
<edit-button> f track-add*
drop ;
: update-slot ( editable-slot -- ) : update-slot ( editable-slot -- )
[ [ ref>> get-ref ] [ printer>> ] bi call ] keep [ [ ref>> get-ref ] [ printer>> ] bi call ] keep

View File

@ -4,7 +4,7 @@
USING: accessors kernel fry math math.vectors sequences arrays vectors assocs USING: accessors kernel fry math math.vectors sequences arrays vectors assocs
hashtables models models.range models.compose combinators hashtables models models.range models.compose combinators
ui ui.gadgets ui.gadgets.buttons ui.gadgets.frames ui.gadgets.packs ui ui.gadgets ui.gadgets.buttons ui.gadgets.frames ui.gadgets.packs
ui.gadgets.grids ui.gadgets.viewports ui.gadgets.books ; ui.gadgets.grids ui.gadgets.viewports ui.gadgets.books locals ;
IN: ui.gadgets.tabs IN: ui.gadgets.tabs
@ -12,11 +12,12 @@ TUPLE: tabbed < frame names toggler content ;
DEFER: (del-page) DEFER: (del-page)
: add-toggle ( model n name toggler -- ) :: add-toggle ( model n name toggler -- )
[ [ gadget-parent '[ , , , (del-page) ] "X" swap <frame>
<bevel-button> @right frame, ] 3keep n name toggler parent>> '[ , , , (del-page) ] "X" swap <bevel-button>
[ swapd <toggle-button> @center frame, ] dip ] make-frame @right grid-add*
add-gadget drop ; n model name <toggle-button> @center grid-add*
toggler swap add-gadget drop ;
: redo-toggler ( tabbed -- ) : redo-toggler ( tabbed -- )
[ names>> ] [ model>> ] [ toggler>> ] tri [ names>> ] [ model>> ] [ toggler>> ] tri

View File

@ -8,10 +8,7 @@ ARTICLE: "ui-track-layout" "Track layouts"
"Creating empty tracks:" "Creating empty tracks:"
{ $subsection <track> } { $subsection <track> }
"Adding children:" "Adding children:"
{ $subsection track-add } { $subsection track-add } ;
"Creating new tracks using a combinator:"
{ $subsection make-track }
{ $subsection track, } ;
HELP: track HELP: track
{ $class-description "A track is like a " { $link pack } " except each child is resized to a fixed multiple of the track's dimension in the direction of " { $link gadget-orientation } ". Tracks are created by calling " { $link <track> } "." } ; { $class-description "A track is like a " { $link pack } " except each child is resized to a fixed multiple of the track's dimension in the direction of " { $link gadget-orientation } ". Tracks are created by calling " { $link <track> } "." } ;
@ -20,18 +17,8 @@ HELP: <track>
{ $values { "orientation" "an orientation specifier" } { "track" "a new " { $link track } } } { $values { "orientation" "an orientation specifier" } { "track" "a new " { $link track } } }
{ $description "Creates a new track which lays out children along the given axis. Children are laid out vertically if the orientation is " { $snippet "{ 0 1 }" } " and horizontally if the orientation is " { $snippet "{ 1 0 }" } "." } ; { $description "Creates a new track which lays out children along the given axis. Children are laid out vertically if the orientation is " { $snippet "{ 0 1 }" } " and horizontally if the orientation is " { $snippet "{ 1 0 }" } "." } ;
{ <track> make-track } related-words
HELP: track-add HELP: track-add
{ $values { "gadget" gadget } { "track" track } { "constraint" "a number between 0 and 1, or " { $link f } } } { $values { "gadget" gadget } { "track" track } { "constraint" "a number between 0 and 1, or " { $link f } } }
{ $description "Adds a new child to a track. If the constraint is " { $link f } ", the child always occupies its preferred size. Otherwise, the constrant is a fraction of the total size which is allocated for the child." } ; { $description "Adds a new child to a track. If the constraint is " { $link f } ", the child always occupies its preferred size. Otherwise, the constrant is a fraction of the total size which is allocated for the child." } ;
HELP: track,
{ $values { "gadget" gadget } { "constraint" "a number between 0 and 1, or " { $link f } } }
{ $description "Adds a new child to a track. If the constraint is " { $link f } ", the child always occupies its preferred size. Otherwise, the constrant is a fraction of the total size which is allocated for the child. This word can only be called inside the quotation passed to " { $link make-track } "." } ;
HELP: make-track
{ $values { "quot" quotation } { "orientation" "an orientation specifier" } { "track" track } }
{ $description "Creates a new track. The quotation can add children by calling the " { $link track, } " word." } ;
ABOUT: "ui-track-layout" ABOUT: "ui-track-layout"

View File

@ -1,15 +1,16 @@
USING: kernel ui.gadgets ui.gadgets.tracks tools.test math.geometry.rect ; USING: kernel ui.gadgets ui.gadgets.tracks tools.test
math.geometry.rect accessors ;
IN: ui.gadgets.tracks.tests IN: ui.gadgets.tracks.tests
[ { 100 100 } ] [ [ { 100 100 } ] [
[ { 0 1 } <track>
<gadget> { 100 100 } over set-rect-dim 1 track, <gadget> { 100 100 } >>dim 1 track-add*
] { 0 1 } make-track pref-dim pref-dim
] unit-test ] unit-test
[ { 100 110 } ] [ [ { 100 110 } ] [
[ { 0 1 } <track>
<gadget> { 10 10 } over set-rect-dim f track, <gadget> { 10 10 } >>dim f track-add*
<gadget> { 100 100 } over set-rect-dim 1 track, <gadget> { 100 100 } >>dim 1 track-add*
] { 0 1 } make-track pref-dim pref-dim
] unit-test ] unit-test

View File

@ -53,12 +53,6 @@ M: track pref-dim*
pick sizes>> push pick sizes>> push
add-gadget ; add-gadget ;
: track, ( gadget constraint -- )
gadget get swap track-add ;
: make-track ( quot orientation -- track )
<track> swap make-gadget ; inline
: track-remove ( gadget track -- ) : track-remove ( gadget track -- )
over [ over [
[ gadget-children index ] 2keep [ gadget-children index ] 2keep

View File

@ -31,7 +31,7 @@ TUPLE: listener-gadget < track input output stack ;
: welcome. ( -- ) : welcome. ( -- )
"If this is your first time with Factor, please read the " print "If this is your first time with Factor, please read the " print
"cookbook" ($link) "." print nl ; "handbook" ($link) "." print nl ;
M: listener-gadget focusable-child* M: listener-gadget focusable-child*
input>> ; input>> ;

View File

@ -232,13 +232,7 @@ ARTICLE: "ui-layout-combinators" "Creating layouts using combinators"
"The " { $link make } " combinator provides a convenient way of constructing sequences by keeping the intermediate sequence off the stack until construction is done. The " { $link , } " and " { $link % } " words operate on this implicit sequence, reducing stack noise." "The " { $link make } " combinator provides a convenient way of constructing sequences by keeping the intermediate sequence off the stack until construction is done. The " { $link , } " and " { $link % } " words operate on this implicit sequence, reducing stack noise."
$nl $nl
"Similar tools exist for constructing complex gadget hierarchies. Different words are used for different types of gadgets; see " { $link "ui-pack-layout" } ", " { $link "ui-track-layout" } " and " { $link "ui-frame-layout" } " for specifics. This section documents their common factors." "Similar tools exist for constructing complex gadget hierarchies. Different words are used for different types of gadgets; see " { $link "ui-pack-layout" } ", " { $link "ui-track-layout" } " and " { $link "ui-frame-layout" } " for specifics. This section documents their common factors."
$nl ;
"Gadget construction combinators whose names are prefixed with " { $snippet "make-" } " construct new gadgets and push them on the stack. The primitive combinator used to define all combinators of this form:"
{ $subsection make-gadget }
"Words such as " { $link track, } " access the gadget through the " { $link gadget } " variable."
$nl
"A combinator which stores a gadget in the " { $link gadget } " variable:"
{ $subsection with-gadget } ;
ARTICLE: "ui-null-layout" "Manual layouts" ARTICLE: "ui-null-layout" "Manual layouts"
"When automatic layout is not appropriate, gadgets can be added to a parent with no layout policy, and then positioned and sized manually:" "When automatic layout is not appropriate, gadgets can be added to a parent with no layout policy, and then positioned and sized manually:"