-- | 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)

-- | Wrapper for temporarily mapping the relationship to a `Span`.
data WithSpan a = WithSpan RS.ResolvedSpan a

instance Functor WithSpan where
    fmap f (WithSpan s a) = WithSpan s (f a)

splitBySpanIndex :: [WithSpan a] -> [[a]]
splitBySpanIndex xs = [getBySpanIndex i xs | i <- [0..]]

getBySpanIndex :: Int -> [WithSpan a] -> [a]
getBySpanIndex idx xs = map contents $ filter matchingIndex $ xs
    where
        matchingIndex (WithSpan rs _) = (RS.spanIndex rs) == idx
        contents (WithSpan _ x) = x

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 layouts
    where
        pRect = containRects allRects
        allRects = concat $ map spanRects layouts
        layouts = snd $ addSpansH 0 spans
        spans = resolveSpans paragraph

-- | Calculate layout for all given spans,
-- arrange them in one horizontal direction starting from the given x_offset,
-- and return the final x_offset for continuation.
addSpansH :: Int32 -> [RS.ResolvedSpan] -> (Int32, [SpanLayout])
addSpansH currentX rss = mapAccumL addSpanH currentX rss

-- TODO: Break lines.
-- TODO: Allow a run across multiple spans (e.g. if they only differ by colour).

-- | Calculate layout for the given span, arrange each of its fragments
-- in one horizontal direction starting from the given x_offset,
-- and return the final x_offset for continuation.
addSpanH :: Int32 -> RS.ResolvedSpan -> (Int32, SpanLayout)
addSpanH currentX rs = (nextX, SpanLayout frags)
    where (nextX, frags) = mapAccumL addRunH currentX $ spanToRunsWrapped rs

spanToRunsWrapped :: RS.ResolvedSpan -> [WithSpan Run]
spanToRunsWrapped s = map (WithSpan s) (spanToRuns s)

-- | Calculate layout for the given run,
-- place the generated fragment horizontally at the given x_offset,
-- and return the final x_offset for continuation.
addRunH :: Int32 -> WithSpan Run -> (Int32, Fragment)
addRunH currentX run = (nextX, nextFrag)
    where
        frag = layoutRun run
        rect = fragmentRect frag
        nextX = currentX + x_size rect
        nextFrag = frag { fragmentRect = nextRect }
        nextRect = rect { x_origin = currentX }

layoutRun :: WithSpan Run -> Fragment
layoutRun (WithSpan rs 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 (WithSpan rs 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

-- | Calculate layout for the given run independently of its position.
shapeRun :: WithSpan Run -> [(GlyphInfo, GlyphPos)]
shapeRun (WithSpan rs 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 = []

resolveSpans :: Paragraph -> [RS.ResolvedSpan]
resolveSpans (Paragraph arr off spans opts) = do
    let texts = cuts arr off spans
    let indexes = [0..]
    (s, t, i) <- zip3 spans texts indexes
    return RS.ResolvedSpan
        { RS.spanIndex = i
        , RS.spanText = t
        , RS.spanFont = paragraphFont opts
        , RS.spanLineHeight = paragraphLineHeight opts
        , RS.spanLanguage = spanLanguage s
        }

-- | 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)