10 files changed, 76 insertions(+), 16 deletions(-)

A .golden/lineHeightLarger/golden
A .golden/lineHeightNormal/golden
A .golden/lineHeightSmaller/golden
M balkon.cabal
A src/Data/Text/ParagraphLayout/LineHeight.hs
M src/Data/Text/ParagraphLayout/Plain.hs
M src/Data/Text/ParagraphLayout/ResolvedSpan.hs
M test/Data/Text/ParagraphLayout/ParagraphData.hs
M test/Data/Text/ParagraphLayout/PlainSpec.hs
M test/Data/Text/ParagraphLayout/SpanData.hs

@@ 0,0 1,5 @@
+ParagraphLayout {paragraphRect = Rect {x_origin = 0, y_origin = 0, x_size = 522, y_size = 1600}, spanLayouts = [
+    SpanLayout [Fragment {fragmentRect = Rect {x_origin = 0, y_origin = 0, x_size = 522, y_size = 1600}, fragmentPen = (0,428), fragmentGlyphs =
+        [(GlyphInfo {codepoint = 68, cluster = 0, unsafeToBreak = False, unsafeToConcat = False, safeToInsertTatweel = False},GlyphPos {x_advance = 522, y_advance = 0, x_offset = 0, y_offset = 0})]
+    }]
+]}

@@ 0,0 1,5 @@
+ParagraphLayout {paragraphRect = Rect {x_origin = 0, y_origin = 0, x_size = 522, y_size = 1121}, spanLayouts = [
+    SpanLayout [Fragment {fragmentRect = Rect {x_origin = 0, y_origin = 0, x_size = 522, y_size = 1121}, fragmentPen = (0,189), fragmentGlyphs =
+        [(GlyphInfo {codepoint = 68, cluster = 0, unsafeToBreak = False, unsafeToConcat = False, safeToInsertTatweel = False},GlyphPos {x_advance = 522, y_advance = 0, x_offset = 0, y_offset = 0})]
+    }]
+]}

@@ 0,0 1,5 @@
+ParagraphLayout {paragraphRect = Rect {x_origin = 0, y_origin = 0, x_size = 522, y_size = 599}, spanLayouts = [
+    SpanLayout [Fragment {fragmentRect = Rect {x_origin = 0, y_origin = 0, x_size = 522, y_size = 599}, fragmentPen = (0,-72), fragmentGlyphs =
+        [(GlyphInfo {codepoint = 68, cluster = 0, unsafeToBreak = False, unsafeToConcat = False, safeToInsertTatweel = False},GlyphPos {x_advance = 522, y_advance = 0, x_offset = 0, y_offset = 0})]
+    }]
+]}

@@ 98,6 98,7 @@ library
     exposed-modules:
         Data.Text.ParagraphLayout,
         Data.Text.ParagraphLayout.Fragment,
+        Data.Text.ParagraphLayout.LineHeight,
         Data.Text.ParagraphLayout.Plain,
         Data.Text.ParagraphLayout.Rect,
         Data.Text.ParagraphLayout.ResolvedSpan,

@@ 0,0 1,15 @@
+module Data.Text.ParagraphLayout.LineHeight (LineHeight(..))
+where
+
+import Data.Int (Int32)
+
+data LineHeight
+
+    = Normal
+    -- ^ Determine the preferred line height automatically using its ascent and
+    -- descent metrics.
+
+    | Absolute Int32
+    -- ^ Set the preferred line height independently of the font.
+
+    deriving (Eq, Show)

@@ 29,6 29,7 @@ import Data.Text.Glyphize
     ,ContentType(ContentTypeUnicode)
     ,Font
     ,FontExtents(..)
+    ,GlyphInfo
     ,GlyphPos(x_advance)
     ,defaultBuffer
     ,fontExtentsForDir


@@ 38,6 39,7 @@ import Data.Text.Internal (Text(Text))
 import qualified Data.Text.Lazy as Lazy
 
 import Data.Text.ParagraphLayout.Fragment
+import Data.Text.ParagraphLayout.LineHeight
 import Data.Text.ParagraphLayout.Rect
 import qualified Data.Text.ParagraphLayout.ResolvedSpan as RS
 import Data.Text.ParagraphLayout.Run


@@ 72,15 74,6 @@ data ParagraphOptions = ParagraphOptions
     , paragraphMaxWidth :: Int32
     }
 
-data LineHeight
-
-    = Normal
-    -- ^ Determine the preferred line height automatically using its ascent and
-    -- descent metrics.
-
-    | Absolute Int32
-    -- ^ Set the preferred line height independently of the font.
-
 -- | The resulting layout of the whole paragraph.
 data ParagraphLayout = ParagraphLayout
     { paragraphRect :: Rect Int32


@@ 130,30 123,38 @@ layoutPlain paragraph = ParagraphLayout pRect arrangedLayouts
 layoutSpan :: RS.ResolvedSpan -> SpanLayout
 layoutSpan rs = SpanLayout (map layoutRun $ spanToRuns rs)
 
--- TODO: Calculate line height and pen position.
 layoutRun :: Run -> Fragment
 layoutRun run = Fragment rect (penX, penY) glyphs
     where
         rect = containGlyphsH lineHeight $ map snd $ glyphs
-        -- TODO: Add half-leadings as required by ParagraphOptions.
         penX = 0 -- for horizontal text
-        penY = descent
-        lineHeight = ascent + descent
+        penY = descent + leading `div` 2
+        glyphs = shapeRun run
+        lineHeight = case RS.spanLineHeight rs of
+            Normal -> normalLineHeight
+            Absolute h -> h
+        leading = lineHeight - normalLineHeight
+        normalLineHeight = ascent + descent
         ascent = ascender extents
         descent = - descender extents
         extents = fontExtentsForDir font dir
-        glyphs = shape font buffer features
+        font = RS.spanFont rs
+        dir = runDirection run
+        rs = runOriginalSpan run
+
+shapeRun :: Run -> [(GlyphInfo, GlyphPos)]
+shapeRun run = shape font buffer features
+    where
         font = RS.spanFont rs
         -- TODO: Set beginsText / endsText.
         buffer = defaultBuffer
             { text = Lazy.fromStrict $ runText run
             , contentType = Just ContentTypeUnicode
-            , direction = dir
+            , direction = runDirection run
             , script = runScript run
             , language = Just $ RS.spanLanguage rs
             }
         features = []
-        dir = runDirection run
         rs = runOriginalSpan run
 
 resolveSpans :: Paragraph -> [RS.ResolvedSpan]


@@ 162,6 163,7 @@ resolveSpans (Paragraph arr off spans opts) = map resolve $ zip spans texts
         resolve (s, t) = RS.ResolvedSpan
             { RS.spanText = t
             , RS.spanFont = paragraphFont opts
+            , RS.spanLineHeight = paragraphLineHeight opts
             , RS.spanLanguage = spanLanguage s
             }
         texts = cuts arr off spans

@@ 4,11 4,14 @@ where
 import Data.Text (Text)
 import Data.Text.Glyphize (Font)
 
+import Data.Text.ParagraphLayout.LineHeight
+
 -- | Internal structure containing resolved values that may be shared with
 -- other spans across the paragraph.
 data ResolvedSpan = ResolvedSpan
     { spanText :: Text
     , spanFont :: Font
+    , spanLineHeight :: LineHeight
     , spanLanguage :: String
     }
     deriving (Eq, Show)

@@ 4,6 4,7 @@ module Data.Text.ParagraphLayout.ParagraphData
     ,emptySpanParagraph
     ,mixedLanguageLTRParagraph
     ,mixedScriptSerbianParagraph
+    ,trivialParagraph
     )
 where
 


@@ 16,6 17,9 @@ emptyParagraph = "" |<>| ""
 emptySpanParagraph :: ParagraphOptions -> Paragraph
 emptySpanParagraph = "" |< "en"~"" >| ""
 
+trivialParagraph :: ParagraphOptions -> Paragraph
+trivialParagraph = "" |< "en"~"a" >| ""
+
 czechHelloParagraph :: ParagraphOptions -> Paragraph
 czechHelloParagraph = "" |< "cs"~"Ahoj, světe!" >| ""
 

@@ 8,6 8,7 @@ import Test.Hspec.Golden
 import System.FilePath ((</>))
 import Data.Text.ParagraphLayout.FontLoader
 import Data.Text.ParagraphLayout.Fragment
+import Data.Text.ParagraphLayout.LineHeight
 import Data.Text.ParagraphLayout.ParagraphData
 import Data.Text.ParagraphLayout.Plain
 


@@ 89,3 90,18 @@ spec = do
         it "handles mixed languages in LTR layout" $ \font -> do
             let result = layoutPlain $ mixedLanguageLTRParagraph $ opts font
             result `shouldBeGolden` "mixedLanguageLTRParagraph"
+        it "handles normal line height" $ \font -> do
+            let result = layoutPlain $ trivialParagraph $ (opts font) {
+                paragraphLineHeight = Normal
+            }
+            result `shouldBeGolden` "lineHeightNormal"
+        it "handles larger line height" $ \font -> do
+            let result = layoutPlain $ trivialParagraph $ (opts font) {
+                paragraphLineHeight = Absolute 1600
+            }
+            result `shouldBeGolden` "lineHeightLarger"
+        it "handles smaller line height" $ \font -> do
+            let result = layoutPlain $ trivialParagraph $ (opts font) {
+                paragraphLineHeight = Absolute 599
+            }
+            result `shouldBeGolden` "lineHeightSmaller"

@@ 7,12 7,14 @@ where
 
 import Data.Text (pack)
 import Data.Text.Glyphize (Font)
+import Data.Text.ParagraphLayout.LineHeight (LineHeight(Normal))
 import Data.Text.ParagraphLayout.ResolvedSpan (ResolvedSpan(..))
 
 emptySpan :: Font -> ResolvedSpan
 emptySpan font = ResolvedSpan
     { spanText = pack ""
     , spanFont = font
+    , spanLineHeight = Normal
     , spanLanguage = "en"
     }
 


@@ 20,6 22,7 @@ czechHello :: Font -> ResolvedSpan
 czechHello font = ResolvedSpan
     { spanText = pack "Ahoj, světe!"
     , spanFont = font
+    , spanLineHeight = Normal
     , spanLanguage = "cs"
     }
 


@@ 27,5 30,6 @@ serbianMixedScript :: Font -> ResolvedSpan
 serbianMixedScript font = ResolvedSpan
     { spanText = pack "Vikipedija (Википедија)"
     , spanFont = font
+    , spanLineHeight = Normal
     , spanLanguage = "sr"
     }