-- | Shaping for a paragraph of plain, unidirectional text using a single font.
--
-- The input text must be encoded as UTF-8 in a contiguous byte array.
--
-- Positions and distances are represented as 32-bit integers. Their unit must
-- be defined by the caller, who must calculate the desired dimensions of the
-- EM square of the input font and set them using @hb_font_set_scale()@. For
-- example, if @1em = 20px@, if the output pixels are square, and if the output
-- coordinates are in 1/64ths of a pixel, you should set both the @x_scale@ and
-- the @y_scale@ to @1280@.
module Data.Text.ParagraphLayout.Plain
    (LineHeight(..)
    ,Paragraph(..)
    ,ParagraphLayout(..)
    ,ParagraphOptions(..)
    ,Rect(..)
    ,Span(..)
    ,SpanLayout(..)
    ,layoutPlain
    )
where

import Data.Int (Int32)
import Data.List (mapAccumL)
import Data.Text.Array (Array)
import Data.Text.Foreign (I8)
import Data.Text.Glyphize
    (Buffer(..)
    ,ContentType(ContentTypeUnicode)
    ,Font
    ,FontExtents(..)
    ,GlyphInfo
    ,GlyphPos(x_advance)
    ,defaultBuffer
    ,fontExtentsForDir
    ,shape
    )
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
import Data.Text.ParagraphLayout.Span

-- | Text to be laid out as a paragraph.
--
-- May be divided into any number of neighbouring spans, each of which will
-- have its own layout rectangle(s) calculated.
data Paragraph = Paragraph

    Array
    -- ^ A byte array containing the whole text to be laid out, in UTF-8.

    I8
    -- ^ Byte offset of the first span.
    -- Any characters preceding this offset will not be shaped, but may still
    -- be used to influence the shape of neighbouring characters.

    [Span]
    -- ^ Parts of the text to be laid out, in logical order.
    -- The offset plus total length of all spans must not exceed array bounds.
    -- Any characters following the last span will not be shaped, but may still
    -- be used to influence the shape of neighbouring characters.

    ParagraphOptions
    -- ^ Properties applying to the paragraph as a whole.

data ParagraphOptions = ParagraphOptions
    { paragraphFont :: Font
    , paragraphLineHeight :: LineHeight
    , paragraphMaxWidth :: Int32
    }

-- | The resulting layout of the whole paragraph.
data ParagraphLayout = ParagraphLayout
    { paragraphRect :: Rect Int32
    -- ^ The containing block (CSS3).
    , spanLayouts :: [SpanLayout]
    }
    deriving (Eq, Read, Show)

-- | The resulting layout of each span, which may include multiple fragments if
-- broken over multiple lines.
data SpanLayout = SpanLayout [Fragment]
    deriving (Eq, Read, Show)

spanRects :: SpanLayout -> [Rect Int32]
spanRects (SpanLayout frags) = map fragmentRect frags

base :: (Num a) => Rect a
base = Rect 0 0 0 0

containRects :: (Ord a, Num a) => [Rect a] -> Rect a
containRects = foldr union base

containGlyphsH :: Int32 -> [GlyphPos] -> Rect Int32
containGlyphsH lineHeight ps = Rect
    { x_origin = 0
    , y_origin = 0
    , x_size = sum $ map x_advance ps
    , y_size = lineHeight
    }

-- | Interface for basic plain text layout.
--
-- The entire paragraph will be assumed to have the same text direction and
-- will be shaped using a single font, aligned to the left for LTR text or to
-- the right for RTL text.
layoutPlain :: Paragraph -> ParagraphLayout
layoutPlain paragraph = ParagraphLayout pRect arrangedLayouts
    where
        pRect = containRects allRects
        allRects = concat $ map spanRects arrangedLayouts
        arrangedLayouts = snd $ arrangeSpansH 0 $ layouts
        layouts = map layoutSpan spans
        spans = resolveSpans paragraph

-- TODO: Break lines.
-- TODO: Allow a run across multiple spans (e.g. if they only differ by colour).
layoutSpan :: RS.ResolvedSpan -> SpanLayout
layoutSpan rs = SpanLayout (map layoutRun $ spanToRuns rs)

layoutRun :: Run -> Fragment
layoutRun run = Fragment rect (penX, penY) glyphs
    where
        rect = containGlyphsH lineHeight $ map snd $ glyphs
        penX = 0 -- for horizontal text
        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
        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 = runDirection run
            , script = runScript run
            , language = Just $ RS.spanLanguage rs
            }
        features = []
        rs = runOriginalSpan run

resolveSpans :: Paragraph -> [RS.ResolvedSpan]
resolveSpans (Paragraph arr off spans opts) = map resolve $ zip spans texts
    where
        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

-- | Produce a list of `Text`s, defined by an initial offset and a list of
-- consecutive `Span`s, out of the underlying `Array`.
--
-- TODO: Consider adding checks for array bounds.
cuts :: Array -> I8 -> [Span] -> [Text]
cuts arr initialOffset spans = snd $ mapAccumL (cut arr) initialOffset spans

-- | Produce a `Text`, defined by an initial offset and a `Span`, out of the
-- underlying `Array`.
cut :: Array -> I8 -> Span -> (I8, Text)
cut arr off s = (end, t)
    where
        len = spanLength s
        end = off + len
        t = Text arr (fromIntegral off) (fromIntegral len)

-- | Arrange all fragments in multiple spans in one horizontal direction
-- and return the final x_offset for continuation.
arrangeSpansH :: Int32 -> [SpanLayout] -> (Int32, [SpanLayout])
arrangeSpansH currentX sls = mapAccumL arrangeSpanH currentX sls

-- | Arrange all fragments in one span in one horizontal direction
-- and return the final x_offset for continuation.
arrangeSpanH :: Int32 -> SpanLayout -> (Int32, SpanLayout)
arrangeSpanH currentX (SpanLayout frags) = (nextX, SpanLayout newFragments)
    where (nextX, newFragments) = arrangeFragmentsH currentX frags

-- | Arrange fragments in one horizontal direction
-- and return the final x_offset for continuation.
arrangeFragmentsH :: Int32 -> [Fragment] -> (Int32, [Fragment])
arrangeFragmentsH currentX frags = mapAccumL arrangeFragmentH currentX frags

-- | Set the horizontal offset of the given box
-- and return the x coordinate of its other side for continuation.
arrangeFragmentH :: Int32 -> Fragment -> (Int32, Fragment)
arrangeFragmentH currentX frag = (nextX, frag { fragmentRect = newRect })
    where
        rect = fragmentRect frag
        nextX = currentX + x_size rect
        newRect = rect { x_origin = currentX }