From 4d69475cacae26639c26cf94e0c14ed23687ba40 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 12 Feb 2009 16:52:24 -0600 Subject: [PATCH] Add support for Joe's "graphics baseline" idea --- basis/ui/gadgets/borders/borders.factor | 3 +- basis/ui/gadgets/gadgets-tests.factor | 9 ++++ basis/ui/gadgets/gadgets.factor | 48 +++++++++++++++---- basis/ui/gadgets/grids/grids.factor | 2 +- basis/ui/gadgets/packs/packs-tests.factor | 41 ++++++++++++++++ basis/ui/gadgets/packs/packs.factor | 4 +- basis/ui/gadgets/paragraphs/paragraphs.factor | 18 +++---- .../listener/completion/completion.factor | 2 +- 8 files changed, 104 insertions(+), 23 deletions(-) diff --git a/basis/ui/gadgets/borders/borders.factor b/basis/ui/gadgets/borders/borders.factor index 708b50d709..e7a3787db0 100644 --- a/basis/ui/gadgets/borders/borders.factor +++ b/basis/ui/gadgets/borders/borders.factor @@ -25,7 +25,8 @@ M: border pref-dim* [ min-dim>> ] bi vmax ; M: border baseline - [ size>> second ] [ gadget-child baseline ] bi + ; + [ size>> second ] [ gadget-child baseline ] bi + dup [ + ] [ nip ] if ; : border-major-dim ( border -- dim ) [ dim>> ] [ size>> 2 v*n ] bi v- ; diff --git a/basis/ui/gadgets/gadgets-tests.factor b/basis/ui/gadgets/gadgets-tests.factor index 91f2979b08..72e740dfa0 100644 --- a/basis/ui/gadgets/gadgets-tests.factor +++ b/basis/ui/gadgets/gadgets-tests.factor @@ -164,3 +164,12 @@ M: mock-gadget ungraft* \ graft* must-infer \ ungraft* must-infer + +! Test baseline calculations +[ 10 ] [ 0 10 0 combine-baseline-metrics + ] unit-test +[ 15 ] [ 0 10 5 combine-baseline-metrics + ] unit-test +[ 30 ] [ 30 0 0 combine-baseline-metrics + ] unit-test +[ 35 ] [ 10 0 30 combine-baseline-metrics + ] unit-test +[ 20 ] [ 5 10 10 combine-baseline-metrics + ] unit-test +[ 20 ] [ 20 10 0 combine-baseline-metrics + ] unit-test +[ 55 ] [ 20 10 40 combine-baseline-metrics + ] unit-test \ No newline at end of file diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor index 53ec03ec36..f424ffb1cc 100644 --- a/basis/ui/gadgets/gadgets.factor +++ b/basis/ui/gadgets/gadgets.factor @@ -3,7 +3,7 @@ USING: accessors arrays hashtables kernel models math namespaces make sequences quotations math.vectors combinators sorting binary-search vectors dlists deques models threads -concurrency.flags math.order math.rectangles fry ; +concurrency.flags math.order math.rectangles fry locals ; IN: ui.gadgets ! Values for orientation slot @@ -197,19 +197,49 @@ SYMBOL: +baseline+ GENERIC: baseline ( gadget -- y ) -M: gadget baseline pref-dim second ; +M: gadget baseline drop f ; -: (baseline-align) ( baselines -- ys ) - [ { } ] [ [ supremum ] keep [ - ] with map ] if-empty ; +: (max-ascent-and-descent) ( accum baseline height -- accum' ) + over [ over - 2array vmax ] [ 2drop ] if ; -: baseline-align ( gadgets -- ys ) - [ baseline ] map (baseline-align) ; +: max-ascent-and-descent ( baselines heights -- ascent descent ) + { 0 0 } [ (max-ascent-and-descent) ] 2reduce first2 ; -: (baseline-metrics) ( baselines sizes -- ascent descent ) - { 0 0 } [ second over - 2array vmax ] 2reduce first2 ; +: max-height-with-baseline ( baselines heights -- y ) + 0 [ swap [ max ] [ drop ] if ] 2reduce ; + +: max-height-without-baseline ( baselines heights -- y ) + 0 [ swap [ drop ] [ max ] if ] 2reduce ; + +:: baseline-align ( gadgets -- ys ) + gadgets [ [ baseline ] map ] [ [ pref-dim second ] map ] bi + over 0 [ [ max ] when* ] reduce :> max-baseline + 2dup max-height-without-baseline :> max-height-without-baseline + max-height-without-baseline max-baseline [-] 2 /i :> offset-with-baseline + max-baseline max-height-without-baseline [-] 2 /i :> offset-without-baseline + [ + over [ + drop + max-baseline + offset-with-baseline + ] [ + nip + max-height-without-baseline + offset-without-baseline + ] if [ swap - ] dip + + ] 2map ; + +: combine-baseline-metrics ( height ascent descent -- ascent' descent' ) + [ [ [-] 2 /i ] keep ] dip [ + ] [ max ] bi-curry* bi ; : baseline-metrics ( children sizes -- ascent descent ) - [ [ baseline ] map ] dip (baseline-metrics) ; + #! Consider gadgets with a baseline and those without separately. + [ [ baseline ] map ] [ [ second ] map ] bi* + [ max-height-without-baseline ] [ max-ascent-and-descent ] 2bi + combine-baseline-metrics ; + +: baseline-height ( children sizes -- height ) + baseline-metrics + ; GENERIC: layout* ( gadget -- ) diff --git a/basis/ui/gadgets/grids/grids.factor b/basis/ui/gadgets/grids/grids.factor index ce7c7070e4..a5ea56d54e 100644 --- a/basis/ui/gadgets/grids/grids.factor +++ b/basis/ui/gadgets/grids/grids.factor @@ -50,7 +50,7 @@ TUPLE: grid-layout grid gap fill? row-heights column-widths ; : row-heights ( grid-layout -- heights ) [ grid>> ] [ fill?>> ] bi [ [ second ] iterate-cell-dims ] - [ [ dup [ pref-dim>> ] map baseline-metrics + ] map ] + [ [ dup [ pref-dim>> ] map baseline-height ] map ] if ; : column-widths ( grid-layout -- widths ) diff --git a/basis/ui/gadgets/packs/packs-tests.factor b/basis/ui/gadgets/packs/packs-tests.factor index 2d4b4cc432..5d44386eda 100644 --- a/basis/ui/gadgets/packs/packs-tests.factor +++ b/basis/ui/gadgets/packs/packs-tests.factor @@ -20,6 +20,7 @@ IN: ui.gadgets.packs.tests orient ] unit-test +! Test baseline alignment +baseline+ >>align 5 { 10 10 } add-gadget 10 { 10 10 } add-gadget @@ -33,4 +34,44 @@ IN: ui.gadgets.packs.tests "g" get dup layout children>> [ loc>> ] map +] unit-test + +! Test mixed baseline and ordinary alignment + +baseline+ >>align + { 20 20 } >>dim add-gadget + 10 { 10 10 } add-gadget +"g" set + +[ { 30 20 } ] [ "g" get pref-dim ] unit-test + +[ ] [ "g" get layout ] unit-test + +[ V{ { 0 0 } { 20 5 } } ] [ + "g" get children>> [ loc>> ] map +] unit-test + + +baseline+ >>align + { 15 15 } >>dim add-gadget + 5 { 10 10 } add-gadget +"g" set + +[ { 25 15 } ] [ "g" get pref-dim ] unit-test + +[ ] [ "g" get layout ] unit-test + +[ V{ { 0 0 } { 15 5 } } ] [ + "g" get children>> [ loc>> ] map +] unit-test + + +baseline+ >>align + { 20 20 } >>dim add-gadget + 30 { 10 50 } add-gadget +"g" set + +[ { 30 50 } ] [ "g" get pref-dim ] unit-test + +[ ] [ "g" get layout ] unit-test + +[ V{ { 0 5 } { 20 0 } } ] [ + "g" get children>> [ loc>> ] map ] unit-test \ No newline at end of file diff --git a/basis/ui/gadgets/packs/packs.factor b/basis/ui/gadgets/packs/packs.factor index d9121943ba..d997ae50ca 100644 --- a/basis/ui/gadgets/packs/packs.factor +++ b/basis/ui/gadgets/packs/packs.factor @@ -66,7 +66,7 @@ PRIVATE> : max-pack-dim ( pack sizes -- dim ) over align>> +baseline+ eq? - [ [ children>> ] dip baseline-metrics + 0 swap 2array ] [ nip max-dim ] if ; + [ [ children>> ] dip baseline-height 0 swap 2array ] [ nip max-dim ] if ; : pack-pref-dim ( pack sizes -- dim ) [ max-pack-dim ] @@ -81,7 +81,7 @@ M: pack pref-dim* children>> [ 0 ] [ first baseline ] if-empty ; : horizontal-baseline ( pack -- y ) - children>> [ baseline ] [ max ] map-reduce ; + children>> dup pref-dims baseline-metrics drop ; PRIVATE> diff --git a/basis/ui/gadgets/paragraphs/paragraphs.factor b/basis/ui/gadgets/paragraphs/paragraphs.factor index 38ad1a7b5f..9929ade177 100644 --- a/basis/ui/gadgets/paragraphs/paragraphs.factor +++ b/basis/ui/gadgets/paragraphs/paragraphs.factor @@ -29,10 +29,10 @@ TUPLE: paragraph < gadget margin ; : gadget>word ( gadget -- word ) [ ] [ pref-dim first ] [ word-break? ] tri ; -TUPLE: line words ascent descent ; +TUPLE: line words height ; : ( words -- line ) - dup [ key>> ] map dup pref-dims baseline-metrics line boa ; + dup [ key>> ] map dup pref-dims baseline-height line boa ; : wrap-paragraph ( paragraph -- wrapped-paragraph ) [ children>> [ gadget>word ] map ] [ margin>> ] bi @@ -44,17 +44,14 @@ TUPLE: line words ascent descent ; : max-line-width ( wrapped-paragraph -- x ) [ words>> line-width ] [ max ] map-reduce ; -: line-height ( wrapped-line -- ys ) - [ ascent>> ] [ descent>> ] bi + ; - : sum-line-heights ( wrapped-paragraph -- y ) - [ line-height ] sigma ; + [ height>> ] sigma ; M: paragraph pref-dim* wrap-paragraph [ max-line-width ] [ sum-line-heights ] bi 2array ; : line-y-coordinates ( wrapped-paragraph -- ys ) - 0 [ line-height + ] accumulate nip ; + 0 [ height>> + ] accumulate nip ; : word-x-coordinates ( wrapped-line -- xs ) 0 [ width>> + ] accumulate nip ; @@ -75,8 +72,11 @@ M: paragraph layout* [ layout-line ] 2each ; M: paragraph baseline - children>> [ 0 ] [ - first [ loc>> second ] [ baseline ] bi + + wrap-paragraph [ f ] [ + first words>> + [ key>> ] map + dup [ pref-dim ] map + baseline-metrics drop ] if-empty ; PRIVATE> \ No newline at end of file diff --git a/basis/ui/tools/listener/completion/completion.factor b/basis/ui/tools/listener/completion/completion.factor index 1b9d0fb08d..e6f27cb764 100644 --- a/basis/ui/tools/listener/completion/completion.factor +++ b/basis/ui/tools/listener/completion/completion.factor @@ -146,7 +146,7 @@ GENERIC# accept-completion-hook 1 ( item popup -- ) monospace-font >>font t >>selection-required? transparent >>column-line-color - 0 >>gap + 2 >>gap dup '[ _ accept-completion ] >>action ; : ( completion-popup -- scroller )