diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 641f8a4d45..63a15a98af 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -61,7 +61,6 @@ - help search - automatically update help graph when adding/removing articles/words - document conventions -- new turtle graphics tutorial + ui: diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 6cfa8f45a1..7c0848d59a 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -174,6 +174,7 @@ vectors words ; "/library/ui/gadgets.factor" "/library/ui/layouts.factor" "/library/ui/hierarchy.factor" + "/library/ui/gadgets/grids.factor" "/library/ui/gadgets/frames.factor" "/library/ui/world.factor" "/library/ui/paint.factor" diff --git a/library/ui/gadgets/frames.factor b/library/ui/gadgets/frames.factor index 7d7f502b3c..7a50cbae94 100644 --- a/library/ui/gadgets/frames.factor +++ b/library/ui/gadgets/frames.factor @@ -1,14 +1,13 @@ -! Copyright (C) 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. +! Copyright (C) 2005, 2006 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. IN: gadgets USING: arrays generic kernel math namespaces sequences words ; ! A frame arranges gadgets in a 3x3 grid, where the center ! gadgets gets left-over space. -TUPLE: frame grid ; +TUPLE: frame ; -: - { { f f f } { f f f } { f f f } } [ clone ] map ; +: 3 [ drop 3 f ] map ; : @center 1 1 ; : @left 0 1 ; @@ -22,53 +21,10 @@ TUPLE: frame grid ; : @bottom-right 2 2 ; C: frame ( -- frame ) - dup delegate>gadget over set-frame-grid ; + over set-gadget-delegate ; : delegate>frame ( tuple -- ) swap set-delegate ; -: frame-child ( frame i j -- gadget ) rot frame-grid nth nth ; - -: frame-add ( gadget frame i j -- ) - #! Add a gadget to a frame. Use this with frames instead - #! of add-gadget. - >r >r over [ over add-gadget ] when* r> r> - 3dup frame-child unparent rot frame-grid nth set-nth ; - -: frame-remove ( frame i j -- ) - #! Remove a gadget from a frame. Use this with frames - #! instead of unparent. - >r >r >r f r> r> r> frame-add ; - -: reduce-grid ( grid -- seq ) - [ max-dim ] map ; - -: frame-pref-dim ( grid -- dim ) - reduce-grid { 0 0 0 } [ v+ ] reduce ; - -: pref-dim-grid ( grid -- grid ) - [ [ [ pref-dim ] [ { 0 0 0 } ] if* ] map ] map ; - -M: frame pref-dim* ( frame -- dim ) - frame-grid pref-dim-grid - dup flip frame-pref-dim first - swap frame-pref-dim second - 0 3array ; - -: frame-layout ( horiz vert -- grid ) - [ swap [ swap 0 3array ] map-with ] map-with ; - -: do-grid ( dim-grid gadget-grid quot -- ) - -rot [ - [ dup [ pick call ] [ 2drop ] if ] 2each - ] 2each drop ; inline - -: position-grid ( gadgets horiz vert -- ) - [ 0 [ + ] accumulate ] 2apply - frame-layout swap [ set-rect-loc ] do-grid ; - -: resize-grid ( gadgets horiz vert -- ) - frame-layout swap [ set-gadget-dim ] do-grid ; - : (fill-center) ( vec n -- ) over first pick third + - 0 max 1 rot set-nth ; @@ -76,12 +32,9 @@ M: frame pref-dim* ( frame -- dim ) tuck second (fill-center) first (fill-center) ; M: frame layout* ( frame -- dim ) - [ - frame-grid dup pref-dim-grid - dup flip reduce-grid [ first ] map - swap reduce-grid [ second ] map - 2dup - ] keep rect-dim fill-center 3dup position-grid resize-grid ; + dup grid-children swap rect-dim + >r compute-grid 2dup r> + fill-center grid-layout ; : frame-add-spec ( { quot setter loc } -- ) first3 >r >r call diff --git a/library/ui/gadgets/grids.factor b/library/ui/gadgets/grids.factor new file mode 100644 index 0000000000..59904bf94f --- /dev/null +++ b/library/ui/gadgets/grids.factor @@ -0,0 +1,67 @@ +! Copyright (C) 2006 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +IN: gadgets +USING: arrays gadgets-panes kernel math sequences ; + +TUPLE: grid children ; + +: collapse-grid concat [ ] subset ; + +: set-grid-children* ( children grid -- ) + [ set-grid-children ] 2keep + >r collapse-grid r> add-gadgets ; + +C: grid ( children -- grid ) + dup delegate>gadget [ set-grid-children* ] keep ; + +: grid-child ( grid i j -- gadget ) rot grid-children nth nth ; + +: grid-add ( gadget grid i j -- ) + >r >r over [ over add-gadget ] when* r> r> + 3dup grid-child unparent rot grid-children nth set-nth ; + +: grid-remove ( grid i j -- ) + >r >r >r f r> r> r> grid-add ; + +: reduce-grid [ max-dim ] map ; + +: grid-pref-dim ( dims -- dim ) + reduce-grid { 0 0 0 } [ v+ ] reduce ; + +: pref-dim-grid ( children -- dims ) + [ [ [ pref-dim ] [ { 0 0 0 } ] if* ] map ] map ; + +M: grid pref-dim* ( frame -- dim ) + grid-children pref-dim-grid + dup flip grid-pref-dim first + swap grid-pref-dim second + 0 3array ; + +: pair-up ( horiz vert -- dims ) + [ swap [ swap 0 3array ] map-with ] map-with ; + +: do-grid ( children dims quot -- ) + -rot swap [ + [ dup [ pick call ] [ 2drop ] if ] 2each + ] 2each drop ; inline + +: position-grid ( children horiz vert -- ) + [ 0 [ + ] accumulate ] 2apply + pair-up [ set-rect-loc ] do-grid ; + +: resize-grid ( children horiz vert -- ) + pair-up [ set-gadget-dim ] do-grid ; + +: grid-layout ( children horiz vert -- ) + 3dup position-grid resize-grid ; + +: compute-grid ( children -- horiz vert ) + pref-dim-grid + dup flip reduce-grid [ first ] map + swap reduce-grid [ second ] map ; + +M: grid layout* ( frame -- dim ) + grid-children dup compute-grid grid-layout ; + +: pane-grid ( quot grid -- gadget ) + [ [ swap make-pane ] map-with ] map-with ; diff --git a/library/ui/layouts.factor b/library/ui/layouts.factor index 8dca9d7eca..ebeb823963 100644 --- a/library/ui/layouts.factor +++ b/library/ui/layouts.factor @@ -34,7 +34,6 @@ IN: gadgets dup gadget-relayout? [ drop ] [ dup invalidate add-invalid ] if ; - : show-gadget t over set-gadget-visible? relayout-1 ; : hide-gadget f over set-gadget-visible? relayout-1 ;