ui.baseline-alignment: add concept of "aligned-gadget".

This type of gadget caches baseline and cap-height for performance.

basis/ui/baseline-alignment/baseline-alignment-docs.factor

@@ -0,0 +1,10 @@
+
+USING: help.markup help.syntax ui.baseline-alignment ui.gadgets ;
+
+HELP: aligned-gadget
+{ $class-description "A " { $link gadget } " that adds the following slots:"
+    { $list
+        { { $snippet "baseline" } " - a cached value for " { $link baseline } "; do not read or write this slot directly." }
+        { { $snippet "cap-height" } " - a cached value for " { $link cap-height } "; do not read or write this slot directly." }
+    }
+} ;

basis/ui/baseline-alignment/baseline-alignment.factor

@@ -6,14 +6,35 @@ IN: ui.baseline-alignment
 
 SYMBOL: +baseline+
 
+
+TUPLE: aligned-gadget < gadget baseline cap-height ;
+
+GENERIC: baseline* ( gadget -- y )
+
 GENERIC: baseline ( gadget -- y )
 
 M: gadget baseline drop f ;
 
+M: aligned-gadget baseline
+    dup baseline>>
+    [ ] [
+        [ baseline* ] [ ] [ layout-state>> ] tri
+        [ drop ] [ dupd baseline<< ] if
+    ] ?if ;
+
+GENERIC: cap-height* ( gadget -- y )
+
 GENERIC: cap-height ( gadget -- y )
 
 M: gadget cap-height drop f ;
 
+M: aligned-gadget cap-height
+    dup cap-height>>
+    [ ] [
+        [ cap-height* ] [ ] [ layout-state>> ] tri
+        [ drop ] [ dupd cap-height<< ] if
+    ] ?if ;
+
 <PRIVATE
 
 ! Text has ascent/descent/cap-height slots, graphics does not.
@@ -63,7 +84,7 @@ PRIVATE>
     dup max-ascent 0 or :> max-ascent
     dup max-cap-height 0 or :> max-cap-height
     dup max-graphics-height :> max-graphics-height
-    
+
     max-cap-height max-graphics-height + 2 /i :> critical-line
     critical-line max-ascent [-] :> text-leading
     max-ascent critical-line [-] :> graphics-leading
@@ -78,4 +99,4 @@ PRIVATE>
     (measure-metrics) combine-metrics ;
 
 : measure-height ( children sizes -- height )
-    (measure-metrics) dup [ combine-metrics + ] [ 3drop ] if ;
+    (measure-metrics) dup [ combine-metrics + ] [ 3drop ] if ;

basis/ui/gadgets/borders/borders.factor

@@ -4,7 +4,7 @@ USING: accessors arrays ui.gadgets ui.baseline-alignment kernel math fry
 namespaces vectors sequences math.vectors math.rectangles ;
 IN: ui.gadgets.borders
 
-TUPLE: border < gadget
+TUPLE: border < aligned-gadget
 { size initial: { 0 0 } }
 { fill initial: { 0 0 } }
 { align initial: { 1/2 1/2 } }
@@ -52,9 +52,9 @@ M: border pref-dim*
 
 PRIVATE>
 
-M: border baseline [ baseline ] border-metric ;
+M: border baseline* [ baseline ] border-metric ;
 
-M: border cap-height [ cap-height ] border-metric ;
+M: border cap-height* [ cap-height ] border-metric ;
 
 M: border layout*
     [ border-child-rect ] [ gadget-child ] bi set-rect-bounds ;

basis/ui/gadgets/labels/labels.factor

@@ -8,7 +8,7 @@ combinators opengl.gl ;
 IN: ui.gadgets.labels
 
 ! A label gadget draws a string.
-TUPLE: label < gadget text font ;
+TUPLE: label < aligned-gadget text font ;
 
 SLOT: string
 
@@ -59,10 +59,10 @@ M: label pref-dim*
 
 PRIVATE>
 
-M: label baseline
+M: label baseline*
     label-metrics ascent>> round ;
 
-M: label cap-height
+M: label cap-height*
     label-metrics cap-height>> round ;
 
 M: label draw-gadget*

basis/ui/gadgets/packs/packs.factor

@@ -5,7 +5,7 @@ ui.baseline-alignment.private kernel math math.functions math.vectors
 math.order math.rectangles namespaces accessors fry combinators arrays ;
 IN: ui.gadgets.packs
 
-TUPLE: pack < gadget
+TUPLE: pack < aligned-gadget
 { align initial: 0 } { fill initial: 0 } { gap initial: { 0 0 } } ;
 
 <PRIVATE
@@ -88,13 +88,13 @@ M: pack pref-dim*
 
 PRIVATE>
 
-M: pack baseline
+M: pack baseline*
     dup orientation>> {
         { vertical [ vertical-baseline ] }
         { horizontal [ horizontal-baseline ] }
     } case ;
 
-M: pack cap-height pack-cap-height ;
+M: pack cap-height* pack-cap-height ;
 
 M: pack layout*
     dup children>> pref-dims pack-layout ;

basis/ui/gadgets/paragraphs/paragraphs.factor

@@ -18,7 +18,7 @@ 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 wrapped ;
+TUPLE: paragraph < aligned-gadget margin wrapped ;
 
 : <paragraph> ( margin -- gadget )
     paragraph new
@@ -40,8 +40,9 @@ TUPLE: line words height baseline ;
     [ children>> [ gadget>word ] map ] [ margin>> ] bi
     dup wrap-words [ <line> ] map ;
 
-M: paragraph children<<
-    [ call-next-method ] [ [ wrap-paragraph ] keep wrapped<< ] bi ;
+: cached-wrapped ( paragraph -- wrapped-paragraph )
+    dup wrapped>>
+    [ nip ] [ [ wrap-paragraph dup ] keep wrapped<< ] if* ;
 
 : line-width ( wrapped-line -- n )
     [ break?>> ] trim-tail-slice [ width>> ] map-sum ;
@@ -53,7 +54,7 @@ M: paragraph children<<
     [ height>> ] map-sum ;
 
 M: paragraph pref-dim*
-    wrapped>> [ max-line-width ] [ sum-line-heights ] bi 2array ;
+    cached-wrapped [ max-line-width ] [ sum-line-heights ] bi 2array ;
 
 : line-y-coordinates ( wrapped-paragraph -- ys )
     0 [ height>> + ] accumulate nip ;
@@ -73,11 +74,12 @@ M: paragraph pref-dim*
     ] dip '[ _ + layout-word ] 3each ;
 
 M: paragraph layout*
-    wrapped>> dup line-y-coordinates [ layout-line ] 2each ;
+    f >>wrapped
+    cached-wrapped dup line-y-coordinates [ layout-line ] 2each ;
 
-M: paragraph baseline
-    wrapped>> [ f ] [ first baseline>> ] if-empty ;
+M: paragraph baseline*
+    cached-wrapped [ f ] [ first baseline>> ] if-empty ;
 
-M: paragraph cap-height pack-cap-height ;
+M: paragraph cap-height* pack-cap-height ;
 
 PRIVATE>