From 10682363533af92ea57a713ca514a85989e3fb5f Mon Sep 17 00:00:00 2001 From: slava Date: Wed, 13 Dec 2006 01:33:00 +0000 Subject: [PATCH] Documented frames, grids, incremental, labels, lists, outliner --- TODO.txt | 1 + core/ui/gadgets/controls.factor | 2 +- core/ui/gadgets/frames.factor | 2 +- core/ui/gadgets/frames.facts | 15 +++++++++- core/ui/gadgets/grid-lines.factor | 3 -- core/ui/gadgets/grid-lines.facts | 5 ++++ core/ui/gadgets/grids.factor | 9 ++---- core/ui/gadgets/grids.facts | 41 ++++++++++++++++++++++++++ core/ui/gadgets/incremental.facts | 28 ++++++++++++++++++ core/ui/gadgets/labelled-gadget.factor | 2 +- core/ui/gadgets/labelled-gadget.facts | 17 +++++++++++ core/ui/gadgets/labels.facts | 23 +++++++++++++++ core/ui/gadgets/lists.factor | 12 ++++---- core/ui/gadgets/lists.facts | 22 ++++++++++++++ core/ui/gadgets/outliner.factor | 18 ++++------- core/ui/gadgets/outliner.facts | 25 ++++++++++++++++ core/ui/gadgets/presentations.factor | 4 +-- core/ui/gadgets/viewports.factor | 2 +- core/ui/hierarchy.facts | 17 +++++++---- core/ui/load.factor | 7 +++++ 20 files changed, 214 insertions(+), 41 deletions(-) create mode 100644 core/ui/gadgets/grid-lines.facts create mode 100644 core/ui/gadgets/grids.facts create mode 100644 core/ui/gadgets/incremental.facts create mode 100644 core/ui/gadgets/labelled-gadget.facts create mode 100644 core/ui/gadgets/labels.facts create mode 100644 core/ui/gadgets/lists.facts create mode 100644 core/ui/gadgets/outliner.facts diff --git a/TODO.txt b/TODO.txt index 7b28265cbe..c01a6b2851 100644 --- a/TODO.txt +++ b/TODO.txt @@ -33,6 +33,7 @@ - string-lines - md5, crc32 - all-words [ word-name ] map prune [ words-named ] map + - 100000 [ "\"hello\" not" eval drop ] times - auto-update browser and help when sources reload - mac intel: struct returns from objc methods - new windows don't always have focus, eg focus follows mouse diff --git a/core/ui/gadgets/controls.factor b/core/ui/gadgets/controls.factor index b926e0fd00..47a1d0e6e8 100644 --- a/core/ui/gadgets/controls.factor +++ b/core/ui/gadgets/controls.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -IN: gadgets USING: kernel models ; +IN: gadgets TUPLE: control self model quot ; diff --git a/core/ui/gadgets/frames.factor b/core/ui/gadgets/frames.factor index 1e158205c5..b1df6d4288 100644 --- a/core/ui/gadgets/frames.factor +++ b/core/ui/gadgets/frames.factor @@ -39,5 +39,5 @@ M: frame layout* : make-frame ( specs -- gadget ) [ swap build-grid ] keep ; inline -: make-frame* ( gadget specs -- gadget ) +: make-frame* ( tuple specs -- gadget ) over [ delegate>frame build-grid ] keep ; inline diff --git a/core/ui/gadgets/frames.facts b/core/ui/gadgets/frames.facts index 13982359aa..38f39f443f 100644 --- a/core/ui/gadgets/frames.facts +++ b/core/ui/gadgets/frames.facts @@ -1,5 +1,5 @@ IN: help -USING: gadgets ; +USING: gadgets kernel arrays ; : $ui-frame-constant { $description "Symbolic constant for a common input to " { $link grid-add } "." } print-element ; @@ -26,3 +26,16 @@ HELP: { $values { "frame" frame } } { $description "Creates a new " { $link frame } " for laying out gadgets in a 3x3 grid." } { $see-also delegate>frame make-frame make-frame* } ; + +HELP: delegate>frame +{ $values { "tuple" tuple } } +{ $description "Sets the tuple's delegate to a new " { $link frame } "." } +{ $side-effects "frame" } ; + +HELP: make-frame +{ $values { "specs" array } { "frame" frame } } +{ $description "Creates a new frame from a declarative specification. See " { $link build-grid } " for a description of the format of " { $snippet "spec" } "." } ; + +HELP: make-frame* +{ $values { "tuple" tuple } { "specs" array } { "frame" frame } } +{ $description "Creates a new frame from a declarative specification and sets " { $snippet "tuple" } "'s delegate to the new frame. See " { $link build-grid } " for a description of the format of " { $snippet "spec" } "." } ; diff --git a/core/ui/gadgets/grid-lines.factor b/core/ui/gadgets/grid-lines.factor index f4a0f1bd98..013c432522 100644 --- a/core/ui/gadgets/grid-lines.factor +++ b/core/ui/gadgets/grid-lines.factor @@ -3,7 +3,6 @@ IN: gadgets USING: kernel math namespaces opengl sequences ; -! You can set a grid's gadget-boundary to this. TUPLE: grid-lines color ; SYMBOL: grid-dim @@ -16,12 +15,10 @@ SYMBOL: grid-dim grid-dim get swap rot set-axis ; : draw-grid-lines ( gaps orientation -- ) - #! Clean this up later. swap grid-positions grid get rect-dim { 1 0 } v- add [ grid-line-from/to gl-line ] each-with ; M: grid-lines draw-boundary - #! Clean this up later. origin get [ grid-lines-color gl-color [ grid get rect-dim half-gap v- grid-dim set diff --git a/core/ui/gadgets/grid-lines.facts b/core/ui/gadgets/grid-lines.facts new file mode 100644 index 0000000000..063daa80b0 --- /dev/null +++ b/core/ui/gadgets/grid-lines.facts @@ -0,0 +1,5 @@ +IN: gadgets +USING: help ; + +HELP: grid-lines +{ $class-description "A class implementing the " { $link draw-boundary } " generic word to draw lines between the cells of a " { $link grid } ". The color of the lines is a color specifier stored in the " { $link grid-lines-color } " slot." } ; diff --git a/core/ui/gadgets/grids.factor b/core/ui/gadgets/grids.factor index 881e044d68..b92717c907 100644 --- a/core/ui/gadgets/grids.factor +++ b/core/ui/gadgets/grids.factor @@ -6,8 +6,7 @@ USING: arrays kernel math namespaces sequences words ; TUPLE: grid children gap ; : set-grid-children* ( children grid -- ) - [ set-grid-children ] 2keep - >r concat [ ] subset r> add-gadgets ; + [ set-grid-children ] 2keep >r concat r> add-gadgets ; C: grid ( children -- grid ) dup delegate>gadget @@ -35,8 +34,7 @@ C: grid ( children -- grid ) : gap grid get grid-gap ; -: (pair-up) ( horiz vert -- dim ) - >r first r> second 2array ; +: (pair-up) ( horiz vert -- dim ) >r first r> second 2array ; M: grid pref-dim* [ @@ -68,9 +66,6 @@ M: grid layout* [ grid-layout ] with-grid ; : build-grid ( grid specs -- ) - #! Specs is an array of quadruples { quot post setter loc }. - #! The setter has stack effect ( new gadget -- ), - #! the loc is @center, @top, etc. swap [ [ grid-add ] build-spec ] with-gadget ; inline M: grid children-on ( rect gadget -- seq ) diff --git a/core/ui/gadgets/grids.facts b/core/ui/gadgets/grids.facts new file mode 100644 index 0000000000..51cadaf33a --- /dev/null +++ b/core/ui/gadgets/grids.facts @@ -0,0 +1,41 @@ +IN: gadgets +USING: help arrays ; + +HELP: grid +{ $class-description "A grid gadget lays out its children so that all gadgets in a column have equal width and all gadgets in a row have equal height. The " { $link grid-gap } " slot stores a pair of integers, the horizontal and vertical gap between children, respectively." +$terpri +"Grids are created by calling " { $link } " and children are managed with " { $link grid-add } " and " { $link grid-remove } "." +$terpri +"The " { $link add-gadget } ", " { $link unparent } " and " { $link clear-gadget } " words should not be used to manage child gadgets of grids." } +{ $see-also frame } ; + +HELP: +{ $values { "children" "a sequence of sequences of gadgets" } } +{ $description "Creates a new " { $link grid } " gadget with the given children." } ; + +HELP: grid-child +{ $values { "grid" grid } { "i" "non-negative integer" } { "j" "non-negative integer" } } +{ $description "Outputs the child gadget at the " { $snippet "i" } "," { $snippet "j" } "th position of the grid." } +{ $errors "Throws an error if the indices are out of bounds." } ; + +HELP: grid-add +{ $values { "gadget" gadget } { "grid" grid } { "i" "non-negative integer" } { "j" "non-negative integer" } } +{ $description "Adds a child gadget at the specified location." } +{ $side-effects "grid" } ; + +HELP: grid-remove +{ $values { "grid" grid } { "i" "non-negative integer" } { "j" "non-negative integer" } } +{ $description "Removes a child gadget from the specified location." } +{ $side-effects "grid" } ; + +HELP: build-grid +{ $values { "grid" grid } { "specs" array } } +{ $description "Constructs gadgets and adds them to the grid by interpreting " { $snippet "spec" } ", which is an array of quadruples of the form " { $snippet "{ quot setter post loc }" } ". The quadruples break down as follows:" + { $list + { { $snippet "quot" } " - a quotation which pushes a new gadget on the stack. The quotation is permitted to consume values from the stack, and it is up to the caller of " { $link build-grid } " to prove the correct amount." } + { { $snippet "setter" } " - a word with stack effect " { $link "( gadget grid -- )" } ". If " { $snippet "grid" } " is a tuple delegating to a " { $link grid } ", this can be used to store the new gadget in a tuple slot." } + { { $snippet "post" } " - a quotation with stack effect " { $snippet "( gadget -- newgadget )" } ", applied to the gadget before it is added to the grid" } + { { $snippet "loc" } " - a word with stack effect " { $snippet "( -- i j )" } " which pushes the grid location where to add the new gadget, for example " { $link @center } "." } + } +} +{ $see-also make-frame make-frame* } ; diff --git a/core/ui/gadgets/incremental.facts b/core/ui/gadgets/incremental.facts new file mode 100644 index 0000000000..6b6acc78b5 --- /dev/null +++ b/core/ui/gadgets/incremental.facts @@ -0,0 +1,28 @@ +IN: gadgets +USING: help ; + +HELP: incremental +{ $class-description "An incremental layout gadget delegates to a " { $link pack } " and implements an optimization which the relayout operation after adding a child to be done in constant time." +$terpri +"Incremental layout gadgets are created by calling " { $link } "." +$terpri +"Children are managed with the " { $link add-incremental } " and " { $link clear-incremental } " words." +$terpri +"Not every " { $link pack } " can use incremental layout, since incremental layout does not support non-default values for " { $link pack-align } ", " { $link pack-fill } ", and " { $link pack-gap } "." } ; + +HELP: +{ $values { "pack" pack } { "incremental" "a new instance of " { $link incremental } } } +{ $description "Creates a new incremental layout gadget delegating to " { $snippet "pack" } "." } +{ $see-also add-incremental clear-incremental } ; + +HELP: add-incremental +{ $values { "gadget" gadget } { "incremental" incremental } } +{ $description "Adds the gadget to the incremental layout and performs relayout immediately in constant time." } +{ $side-effects "incremental" } +{ $see-also add-gadget clear-incremental } ; + +HELP: clear-incremental +{ $values { "incremental" incremental } } +{ $description "Removes all gadgets from the incremental layout and performs relayout immediately in constant time." } +{ $side-effects "incremental" } +{ $see-also add-gadget clear-incremental } ; diff --git a/core/ui/gadgets/labelled-gadget.factor b/core/ui/gadgets/labelled-gadget.factor index 7219cafde8..37b7353e28 100644 --- a/core/ui/gadgets/labelled-gadget.factor +++ b/core/ui/gadgets/labelled-gadget.factor @@ -6,7 +6,7 @@ queues sequences test threads help sequences words timers ; TUPLE: labelled-gadget content ; -C: labelled-gadget ( gadget title -- gadget ) +C: labelled-gadget ( gadget title -- newgadget ) { { [