From abb6c01a628526deb612e74e541267798fdd22ea Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 2 Feb 2009 03:32:13 -0600 Subject: [PATCH] Refactor ui.gadgets.paragraphs to use wrap --- basis/ui/gadgets/packs/packs.factor | 8 +- .../paragraphs/paragraphs-tests.factor | 31 +++++++ basis/ui/gadgets/paragraphs/paragraphs.factor | 88 ++++++++----------- 3 files changed, 73 insertions(+), 54 deletions(-) create mode 100644 basis/ui/gadgets/paragraphs/paragraphs-tests.factor diff --git a/basis/ui/gadgets/packs/packs.factor b/basis/ui/gadgets/packs/packs.factor index 35919751f5..85504ebf15 100644 --- a/basis/ui/gadgets/packs/packs.factor +++ b/basis/ui/gadgets/packs/packs.factor @@ -28,8 +28,10 @@ TUPLE: pack < gadget [ align>> ] [ dim>> ] bi '[ [ _ _ ] dip v- n*v ] map ; : baseline-aligned-locs ( pack -- seq ) - children>> [ baseline ] map [ supremum ] keep - [ - 0 swap 2array ] with map ; + children>> [ { } ] [ + [ baseline ] map [ supremum ] keep + [ - 0 swap 2array ] with map + ] if-empty ; : aligned-locs ( sizes pack -- seq ) dup align>> +baseline+ eq? @@ -77,7 +79,7 @@ M: pack pref-dim* children>> [ 0 ] [ first baseline ] if-empty ; : horizontal-baseline ( pack -- y ) - children>> [ baseline ] map supremum ; + children>> [ baseline ] [ max ] map-reduce ; PRIVATE> diff --git a/basis/ui/gadgets/paragraphs/paragraphs-tests.factor b/basis/ui/gadgets/paragraphs/paragraphs-tests.factor new file mode 100644 index 0000000000..32118742d5 --- /dev/null +++ b/basis/ui/gadgets/paragraphs/paragraphs-tests.factor @@ -0,0 +1,31 @@ +IN: ui.gadgets.paragraphs.tests +USING: ui.gadgets.paragraphs ui.gadgets.paragraphs.private +ui.gadgets accessors tools.test namespaces sequences kernel ; + +TUPLE: fake-break < gadget ; + +: ( -- gadget ) fake-break new-gadget { 5 5 } >>dim ; + +INSTANCE: fake-break word-break + +100 + { 40 30 } >>dim dup "a" set add-gadget + add-gadget + { 40 15 } >>dim dup "b" set add-gadget + add-gadget + { 50 20 } >>dim dup "c" set add-gadget +"p" set + +[ { 4 1 } ] [ "p" get wrap-paragraph [ length ] map ] unit-test + +[ { 85 50 } ] [ "p" get pref-dim ] unit-test + +[ ] [ "p" get prefer ] unit-test + +[ ] [ "p" get layout ] unit-test + +[ { 0 0 } ] [ "a" get loc>> ] unit-test + +[ { 45 0 } ] [ "b" get loc>> ] unit-test + +[ { 0 30 } ] [ "c" get loc>> ] unit-test \ No newline at end of file diff --git a/basis/ui/gadgets/paragraphs/paragraphs.factor b/basis/ui/gadgets/paragraphs/paragraphs.factor index 9cb32da1c3..99e621c0b5 100644 --- a/basis/ui/gadgets/paragraphs/paragraphs.factor +++ b/basis/ui/gadgets/paragraphs/paragraphs.factor @@ -1,10 +1,11 @@ -! Copyright (C) 2005, 2008 Slava Pestov +! Copyright (C) 2005, 2009 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays ui.gadgets ui.gadgets.labels ui.render -kernel math namespaces sequences math.order math.geometry.rect -locals ; +USING: accessors kernel math math.order sequences wrap arrays fry +ui.gadgets ui.gadgets.labels ui.render ; IN: ui.gadgets.paragraphs +MIXIN: word-break + ! A word break gadget TUPLE: word-break-gadget < label ; @@ -13,6 +14,8 @@ TUPLE: word-break-gadget < label ; M: word-break-gadget draw-gadget* drop ; +INSTANCE: word-break-gadget word-break + ! A gadget that arranges its children in a word-wrap style. TUPLE: paragraph < gadget margin ; @@ -21,60 +24,43 @@ TUPLE: paragraph < gadget margin ; horizontal >>orientation swap >>margin ; -SYMBOL: x SYMBOL: max-x +word ( gadget -- word ) + [ ] [ pref-dim first ] [ word-break? ] tri ; -SYMBOL: line-height +: wrap-paragraph ( paragraph -- wrapped-paragraph ) + [ children>> [ gadget>word ] map ] [ margin>> ] bi wrap ; -SYMBOL: margin +: line-width ( wrapped-line -- n ) + [ break?>> ] trim-tail-slice [ width>> ] sigma ; -: overrun? ( width -- ? ) x get + margin get > ; +: max-line-width ( wrapped-paragraph -- x ) + [ line-width ] [ max ] map-reduce ; -: zero-vars ( seq -- ) [ 0 swap set ] each ; +: line-height ( wrapped-line -- ys ) + [ key>> pref-dim second ] [ max ] map-reduce ; -: wrap-line ( -- ) - line-height get y +@ - { x line-height } zero-vars ; - -: wrap-pos ( -- pos ) x get y get 2array ; inline - -: advance-x ( x -- ) - x +@ - x get max-x [ max ] change ; - -: advance-y ( y -- ) - dup line-height [ max ] change - y get + max-y [ max ] change ; - -:: wrap-step ( quot child -- ) - child pref-dim - [ - child - [ - word-break-gadget? - [ drop ] [ first overrun? [ wrap-line ] when ] if - ] - [ wrap-pos quot call ] bi - ] - [ first advance-x ] - [ second advance-y ] - tri ; inline - -: wrap-dim ( -- dim ) max-x get max-y get 2array ; - -: init-wrap ( paragraph -- ) - margin>> margin set - { x max-x y max-y line-height } zero-vars ; - -: do-wrap ( paragraph quot -- dim ) - [ - swap dup init-wrap - [ wrap-step ] with each-child wrap-dim - ] with-scope ; inline +: sum-line-heights ( wrapped-paragraph -- y ) + [ line-height ] sigma ; M: paragraph pref-dim* - [ 2drop ] do-wrap ; + wrap-paragraph [ max-line-width ] [ sum-line-heights ] bi 2array ; + +: line-y-coordinates ( wrapped-paragraph -- ys ) + 0 [ line-height + ] accumulate nip ; + +: word-x-coordinates ( wrapped-line -- xs ) + 0 [ width>> + ] accumulate nip ; + +: layout-word ( word x y -- ) + [ key>> ] 2dip 2array >>loc prefer ; + +: layout-line ( wrapped-line y -- ) + [ dup word-x-coordinates ] dip '[ _ layout-word ] 2each ; M: paragraph layout* - [ swap dup prefer (>>loc) ] do-wrap drop ; + wrap-paragraph dup line-y-coordinates + [ layout-line ] 2each ; + +PRIVATE> \ No newline at end of file