! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel locals math math.functions math.order math.vectors
-sequences ui.gadgets accessors combinators ;
+USING: accessors combinators kernel locals math math.functions
+math.order sequences ui.gadgets ;
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.
[ descent>> ] map ?supremum ;
: max-graphics-height ( seq -- y )
- [ ascent>> not ] filter [ height>> ] map ?supremum 0 or ;
+ [ ascent>> ] reject [ height>> ] map ?supremum 0 or ;
:: combine-metrics ( graphics-height ascent descent cap-height -- ascent' descent' )
ascent [
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
[
dup ascent>>
[ ascent>> max-ascent swap - text-leading ]
- [ height>> max-graphics-height swap - 2/ graphics-leading ] if +
+ [ height>> max-graphics-height swap - 2 /i graphics-leading ] if +
] map ;
: measure-metrics ( children sizes -- ascent descent )
(measure-metrics) combine-metrics ;
: measure-height ( children sizes -- height )
- (measure-metrics) dup [ combine-metrics + ] [ 3drop ] if ;
\ No newline at end of file
+ (measure-metrics) dup [ combine-metrics + ] [ 3drop ] if ;