-- | The document type, which expresses the intent of the user about
-- what to render.
--
-- We support general layouting \/ formatting, and also construction
-- specific to mathematical documents (similar to LaTeX).
--
-- TODO: fractions, brackets, mathemetical accents, compound symbols
--

{-# LANGUAGE OverloadedStrings, BangPatterns #-}
module Graphics.Rendering.MiniTypeset.Document where

--------------------------------------------------------------------------------

import Data.String

-- import qualified Data.Text as T ; import Data.Text (Text)

import Graphics.Rendering.MiniTypeset.Common
import Graphics.Rendering.MiniTypeset.Box ( WhichQuad(..) )

--------------------------------------------------------------------------------
-- * The document data type

-- | This data type describes what the user want to render.
--
-- The type parameter @ident@ is used when the user want to know positions (bounding boxes) of
-- different parts of the rendered text. It must have an 'Ord' instance.
--
data Document ident
  = Symbol       !Char                                     -- ^ a single character or symbol
  | String       !String                                   -- ^ a string 
  | Space                                                  -- ^ a space character (do we need this to be separate?)
  | HorzCat      !VAlign              [Document ident]     -- ^ horizontal concatenation
  | VertCat      !HAlign              [Document ident]     -- ^ vertical concatenation
  | Overlay      !(HAlign,VAlign)     [Document ident]     -- ^ overlaying on the top of each other
  | SubSupScript !(SubSup ident)     !(Document ident)     -- ^ add subscript and\/or superscript
  | AboveBelow   !(AboveBelow ident) !(Document ident)     -- ^ above\/below (like in a summation or limit)
  | WithColor    !Col                !(Document ident)     -- ^ change color
  | WithStyle    !BasicStyle         !(Document ident)     -- ^ change font family
  | Decorated    !TextDecoration     !(Document ident)     -- ^ add text decoration
  | Identified   !ident              !(Document ident)     -- ^ user identifier so that the layout engine can return position information
  | AddMargin    !Margin             !(Document ident)     -- ^ an extra margin around the document
  | Realign      !WhichQuad          !(Document ident)     -- ^ change the alignment box
  | EmptyDoc                                               -- ^ the empty document
  deriving (Eq,Ord,Show)

--------------------------------------------------------------------------------

-- | A text decoration
data TextDecoration
  = Underline
  | Overline
  | StrikeThrough
  deriving (Eq,Ord,Show)

--------------------------------------------------------------------------------

-- | A subscript or a superscript, or both
data SubSup ident
  = Subscript         !(Document ident)
  | Superscript       !(Document ident)
  | SubAndSupscript   !(Document ident) !(Document ident)    -- ^ first is the subscript, second the superscript
  deriving (Eq,Ord,Show)

subSupDocs :: SubSup ident -> (Document ident, Document ident)
subSupDocs subsup = case subsup of
  Subscript         sub     -> (sub      , EmptyDoc)
  Superscript           sup -> (EmptyDoc , sup     )
  SubAndSupscript   sub sup -> (sub      , sup     )

--------------------------------------------------------------------------------

-- | Limits of summations and similar things.
data AboveBelow ident
  = Above         !(Document ident)
  | Below         !(Document ident)
  | AboveAndBelow !(Document ident) !(Document ident)    -- ^ first is the above, second is below
  deriving (Eq,Ord,Show)

aboveBelowDocs :: AboveBelow ident -> (Document ident, Document ident)
aboveBelowDocs abelow = case abelow of
  Above         ab    -> (ab       , EmptyDoc)
  Below            be -> (EmptyDoc , be      )
  AboveAndBelow ab be -> (ab       , be      )

--------------------------------------------------------------------------------
-- * Atomic documents

instance IsString (Document ident) where
  fromString = String

-- text :: Text -> Document a
-- text = String . T.unpack

string :: String -> Document a
string = String

char :: Char -> Document a
char = Symbol

-- | A normal space
space :: Document a
space = Space

-- | A zero-width space (hopefully your chosen unicode font supports it)
zeroWidthSpace :: Document a
zeroWidthSpace = Symbol '\x200B'

--------------------------------------------------------------------------------
-- * Document combinators

-- | Horizontal concatenation
(<|>) :: Document a -> Document a -> Document a
(<|>) x y = hcat [x,y]

-- | Vertical concatenation
(<->) :: Document a -> Document a -> Document a
(<->) x y = vcat [x,y]

-- | Overlay
(<#>) :: Document a -> Document a -> Document a
(<#>) x y = overlay [x,y]

-- | Horizontal concatenation of several document fragments
hcat :: [Document a] -> Document a
hcat = hcatB

-- | Vertical concatenation of several document fragments
vcat :: [Document a] -> Document a
vcat = vcatL

-- | Overlay of several document fragments on top of each other
overlay :: [Document a] -> Document a
overlay = Overlay (AlignLeft,AlignBottom)

hcatB :: [Document a] -> Document a
hcatB = HorzCat AlignBottom

hcatT :: [Document a] -> Document a
hcatT = HorzCat AlignTop

vcatL :: [Document a] -> Document a
vcatL = VertCat AlignLeft

vcatR :: [Document a] -> Document a
vcatR = VertCat AlignRight

-- * Subscript and superscript

subscript :: Document a -> Document a -> Document a
subscript doc sub = SubSupScript (Subscript sub) doc

supscript :: Document a -> Document a -> Document a
supscript doc sup = SubSupScript (Superscript sup) doc

subSup :: Document a -> (Document a, Document a) -> Document a
subSup doc (sub,sup) = SubSupScript (SubAndSupscript sub sup) doc

-- * Above and below

-- | Used for \"big\" mathematical operators (like summation)
above :: Document a -> Document a -> Document a
above doc ab = AboveBelow (Above ab) doc

below :: Document a -> Document a -> Document a
below doc be = AboveBelow (Below be) doc

aboveBelow :: Document a -> (Document a, Document a) -> Document a
aboveBelow doc (ab,be) = AboveBelow (AboveAndBelow ab be) doc

-- * Text decoration

underline, overline, strike :: Document a -> Document a
underline = Decorated Underline
overline  = Decorated Overline
strike    = Decorated StrikeThrough

-- * Font variations

regular, bold, italic, boldItalic :: Document a -> Document a
regular    = WithStyle Regular
bold       = WithStyle Bold
italic     = WithStyle Italic
boldItalic = WithStyle BoldItalic

-- * Colors

white, black, red, green, blue :: Document a -> Document a
white = WithColor (Col 1 1 1)
black = WithColor (Col 0 0 0)
red   = WithColor (Col 1 0 0)
green = WithColor (Col 0 1 0)
blue  = WithColor (Col 0 0 1)

rgb :: Float -> Float -> Float -> Document a -> Document a
rgb r g b = WithColor (Col r g b)

-- * Margins

margin :: Double -> Document a -> Document a
margin x = AddMargin (Margin x x x x)

hmargin :: Double -> Document a -> Document a
hmargin x = AddMargin (Margin x x 0 0)

vmargin :: Double -> Document a -> Document a
vmargin x = AddMargin (Margin 0 0 x x)

margin' :: Double -> Double -> Double -> Double -> Document a -> Document a
margin' l r t b = AddMargin (Margin l r t b)

--------------------------------------------------------------------------------
-- * Brackets (not implemented yet)

data Bracket
  = Paren
  | Square
  | Brace
  | Angle        -- 2329 / 232a
  | Ceil         -- 2308 / 2309
  | Floor        -- 230a / 230b
  | Top          -- 231c / 231d
  | Bottom       -- 231e / 231f
  | AngleQuote   -- 2039 / 203a
  | FrenchQuote  -- 00ab / 00bb
  deriving (Eq,Ord,Show)

bracketChars :: Bracket -> (Char,Char)
bracketChars b = case b of
  Paren        -> ( '(' , ')' )
  Square       -> ( '[' , ']' )
  Brace        -> ( '{' , '}' )
  Angle        -> ( '\x2329' , '\x232a' )
  Ceil         -> ( '\x2308' , '\x2309' )
  Floor        -> ( '\x230a' , '\x230b' )
  Top          -> ( '\x231c' , '\x231d' )
  Bottom       -> ( '\x231e' , '\x231f' )
  AngleQuote   -> ( '\x2039' , '\x203a' )
  FrenchQuote  -> ( '\x00ab' , '\x00bb' )

--------------------------------------------------------------------------------