Box.hs

-- | Boxes are rectangular shapes used for layouting. They consisting of 
-- several quads having a relative position to each other:
--
-- * \"inner boxes\" are used for aligning several boxes together
--
-- * \"outer boxes\" describe the logical extent 
-- 
-- * \"bounding boxes\" are the bounding boxes of the actual content abstracted
--   by the box
--
-- * \"gap boxes\" control the gap between boxes placed next to each other.
--
-- Relative boxes has their origin at the top-left corner of their inner box.
-- Absolute boxes has an absolute offset.
--
-- We use screen-space coordinate system (Y increase downwards).
--
-- In case of font glyphs, the inner box has height 0, and it coincides with
-- the base line of the glyph; while the outer box is defined by the ascent
-- and the descent. Both have horizontal dimensions equal to the advance width.
-- 

{-# LANGUAGE CPP, BangPatterns #-}
module Graphics.Rendering.MiniTypeset.Box where

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

-- Semigroup became a superclass of Monoid at base 4.11
-- there are also conflicts between Monoid and Semigroup :(
#if MIN_VERSION_base(4,11,0)     
import Data.Semigroup
#else
import Data.Monoid     
#endif

import Graphics.Rendering.MiniTypeset.Common

--------------------------------------------------------------------------------
-- * Quads

-- | A quad is a rectangular region, defined by its top-left and bottom-right corner
data Quad = Quad
  { quadTopLeft  :: {-# UNPACK #-} !(Double,Double)
  , quadBotRight :: {-# UNPACK #-} !(Double,Double)
  }
  deriving (Eq,Show)

quadTopRight :: Quad -> (Double,Double)
quadTopRight (Quad (_,y) (x,_)) = (x,y)

quadBotLeft :: Quad -> (Double,Double)
quadBotLeft (Quad (x,_) (_,y)) = (x,y)

quadL,quadR,quadT,quadB :: Quad -> Double
quadL = fst . quadTopLeft
quadT = snd . quadTopLeft
quadR = fst . quadBotRight
quadB = snd . quadBotRight

quadWidth :: Quad -> Double
quadWidth (Quad (l,t) (r,b)) = r-l

quadHeight :: Quad -> Double
quadHeight (Quad (l,t) (r,b)) = b-t

quadSize :: Quad -> (Double,Double)
quadSize (Quad (l,t) (r,b)) = (r-l , b-t)

instance Translate Quad where
  translate ofs (Quad tl br) = Quad (translate ofs tl) (translate ofs br) 

zeroQuad :: Quad 
zeroQuad = Quad (0,0) (0,0)

-- | Least upper bounding quad
quadLUB :: Quad -> Quad -> Quad
quadLUB (Quad (u1,v1) (u2,v2)) (Quad (p1,q1) (p2,q2)) = Quad (x1,y1) (x2,y2) where
  x1 = min u1 p1
  y1 = min v1 q1
  x2 = max u2 p2
  y2 = max v2 q2

ofsLUB :: (Pos,Quad) -> (Pos,Quad) -> Quad
ofsLUB (ofs1,quad1) (ofs2,quad2) = quadLUB (translate ofs1 quad1) (translate ofs2 quad2)

--------------------------------------------------------------------------------
-- monoid/semigroup instance

-- Semigroup became a superclass of Monoid
#if MIN_VERSION_base(4,11,0)        

instance Semigroup Quad where
  (<>) = quadLUB

instance Monoid Quad where
  mempty = zeroQuad

#else

-- It probably should be a semigroup only, but I don't care too much 
-- (also backward compatibility is problematic)
instance Monoid Quad where
  mempty  = zeroQuad
  mappend = quadLUB

#endif

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

-- | Extend a quad with margins
marginQuad :: Margin -> Quad -> Quad
marginQuad (Margin l r t b) (Quad (x1,y1) (x2,y2)) = Quad (x1-l,y1-t) (x2+r,y2+b)

--------------------------------------------------------------------------------
-- * Boxes

-- | A (relative) box
data Box = Box
  { boxInnerSize    :: {-# UNPACK #-} !(Double,Double)
  , boxOuterQuad    :: !Quad
  , boxBoundingQuad :: !Quad
  , boxGapQuad      :: !Quad
  }
  deriving (Show)

boxInnerQuad :: Box -> Quad
boxInnerQuad (Box inner outer bounding gap) = Quad (0,0) inner

emptyBox :: Box
emptyBox = Box (0,0) zeroQuad zeroQuad zeroQuad

-- | Enumerating the four different quads in a 'Box'
data WhichQuad
  = InnerQuad
  | OuterQuad
  | BoundingQuad
  | GapQuad
  deriving (Eq,Ord,Show)

-- | Replace the inner box by the given box. Since the inner box is used for
-- alignment, this amounts to changing the alignment 
realignBox :: WhichQuad -> Box -> Box
realignBox which box@(Box _ outer bounding gap) = 
  case which of
    InnerQuad     -> box
    OuterQuad     -> realign outer
    BoundingQuad  -> realign bounding
    GapQuad       -> realign gap
  where
    realign quad = Box (quadSize quad) (f outer) (f bounding) (f gap) where
      ofs = negate (pairToPos $ quadTopLeft quad)
      f :: Quad -> Quad
      f = translate ofs

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

-- | An absolute box
data AbsBox = AbsBox
  { _aboxOffset :: !Pos
  , _aboxRelBox :: !Box
  }
  deriving (Show)

instance Translate AbsBox where
  translate ofs (AbsBox pos relbox) = AbsBox (ofs+pos) relbox

absboxInnerQuad :: AbsBox -> Quad
absboxInnerQuad (AbsBox ofs relbox) = translate ofs (boxInnerQuad relbox)

absboxOuterQuad :: AbsBox -> Quad
absboxOuterQuad (AbsBox ofs relbox) = translate ofs (boxOuterQuad relbox)

absboxBoundingQuad :: AbsBox -> Quad
absboxBoundingQuad (AbsBox ofs relbox) = translate ofs (boxBoundingQuad relbox)

absboxGapQuad :: AbsBox -> Quad
absboxGapQuad (AbsBox ofs relbox) = translate ofs (boxGapQuad relbox)

--------------------------------------------------------------------------------
-- * Concatenating boxes

-- | Concatantes two boxes horizontally, using the inner boxes to align them.
-- The two positions we return are relative positions of the two boxes from
-- the origin (top-left inner corner) of the concatenated box.
hcatBox :: VAlign -> Box -> Box -> (Box,(Pos,Pos))
hcatBox !valign !box1 !box2 = (box,(pos1,pos2)) where

  box = Box (w,h) outer bound gap 

  (y1,y2) = case valign of { AlignTop  -> (0,0) ; AlignBottom -> (h-h1 , h-h2) }

  pos1 = Pos 0 y1 
  pos2 = Pos x y2

  x = quadR gap1 - quadL gap2

  w = x + w2
  h = max h1 h2
  outer = ofsLUB (pos1,outer1) (pos2,outer2)
  bound = ofsLUB (pos1,bound1) (pos2,bound2)
  gap   = ofsLUB (pos1,  gap1) (pos2,  gap2)

  Box (w1,h1) outer1 bound1 gap1 = box1
  Box (w2,h2) outer2 bound2 gap2 = box2

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

-- | Concatantes two boxes vertically, using the inner boxes to align them.
-- The two positions we return are relative positions of the two boxes from
-- the origin (top-left inner corner) of the concatenated box.
vcatBox :: HAlign -> Box -> Box -> (Box,(Pos,Pos))
vcatBox !halign !box1 !box2 = (box,(pos1,pos2)) where

  box = Box (w,h) outer bound gap 

  (x1,x2) = case halign of { AlignLeft -> (0,0) ; AlignRight  -> (w-w1 , w-w2) }

  pos1 = Pos x1 0 
  pos2 = Pos x2 y 

  y = quadB gap1 - quadT gap2

  h = y + h2
  w = max w1 w2
  outer = ofsLUB (pos1,outer1) (pos2,outer2)
  bound = ofsLUB (pos1,bound1) (pos2,bound2)
  gap   = ofsLUB (pos1,  gap1) (pos2,  gap2)

  Box (w1,h1) outer1 bound1 gap1 = box1
  Box (w2,h2) outer2 bound2 gap2 = box2

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

hcatBox2 :: VAlign -> Box -> Box -> (Box,(AbsBox,AbsBox))
hcatBox2 valign box1 box2 = (box, (AbsBox p1 box1, AbsBox p2 box2)) where (box,(p1,p2)) = hcatBox valign box1 box2

vcatBox2 :: HAlign -> Box -> Box -> (Box,(AbsBox,AbsBox))
vcatBox2 halign box1 box2 = (box, (AbsBox p1 box1, AbsBox p2 box2)) where (box,(p1,p2)) = vcatBox halign box1 box2

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

hcatBoxes :: VAlign -> [Box] -> (Box,[AbsBox])
hcatBoxes !valign boxes = case boxes of
  []         -> ( emptyBox, [] )
  [b]        -> ( b, [AbsBox (Pos 0 0) b] )   
  (b1:b2:bs) -> let (b12,(ab1,ab2) ) = hcatBox2  valign b1 b2
                    (box,(ab12:abs)) = hcatBoxes valign (b12:bs) 
                    p12 = _aboxOffset ab12
                in (box, translate p12 ab1 : translate p12 ab2 : abs)

vcatBoxes :: HAlign -> [Box] -> (Box,[AbsBox])
vcatBoxes !halign boxes = case boxes of
  []         -> ( emptyBox, [] )
  [b]        -> ( b, [AbsBox (Pos 0 0) b] )   
  (b1:b2:bs) -> let (b12,(ab1,ab2) ) = vcatBox2  halign b1 b2
                    (box,(ab12:abs)) = vcatBoxes halign (b12:bs) 
                    p12 = _aboxOffset ab12
                in (box, translate p12 ab1 : translate p12 ab2 : abs)

--------------------------------------------------------------------------------
-- * Overlay boxes

-- | Overlay two boxes (so the corners given by the alignments coincide)
overlayBox :: HAlign -> VAlign -> Box -> Box -> (Box,(Pos,Pos))
overlayBox !halign !valign !box1 !box2 = (box,(pos1,pos2)) where

  box = Box (w,h) outer bound gap 

  Box (w1,h1) outer1 bound1 gap1 = box1
  Box (w2,h2) outer2 bound2 gap2 = box2

  (x1,x2) = case halign of { AlignLeft -> (0,0) ; AlignRight  -> (w-w1 , w-w2) }
  (y1,y2) = case valign of { AlignTop  -> (0,0) ; AlignBottom -> (h-h1 , h-h2) }
 
  pos1 = Pos x1 y1
  pos2 = Pos x2 y2

  w = max w1 w2
  h = max h1 h2

  outer = ofsLUB (pos1,outer1) (pos2,outer2)
  bound = ofsLUB (pos1,bound1) (pos2,bound2)
  gap   = ofsLUB (pos1,  gap1) (pos2,  gap2)

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

overlayBox2 :: HAlign -> VAlign -> Box -> Box -> (Box,(AbsBox,AbsBox))
overlayBox2 halign valign box1 box2 = (box, (AbsBox p1 box1, AbsBox p2 box2)) where
  (box,(p1,p2)) = overlayBox halign valign box1 box2

overlayBoxes :: HAlign -> VAlign -> [Box] -> (Box,[AbsBox])
overlayBoxes !halign !valign boxes = case boxes of
  []         -> ( emptyBox, [] )
  [b]        -> ( b, [AbsBox (Pos 0 0) b] )   
  (b1:b2:bs) -> let (b12,(ab1,ab2) ) = overlayBox2  halign valign b1 b2
                    (box,(ab12:abs)) = overlayBoxes halign valign (b12:bs) 
                    p12 = _aboxOffset ab12
                in (box, translate p12 ab1 : translate p12 ab2 : abs)

--------------------------------------------------------------------------------
-- * Subscripts and superscripts

-- | Subscripts\/superscripts are special enough that it seems simpler to 
-- just add a specific combinator for them.
subSupScriptBox :: Box -> (Double,Box) -> (Double,Box) -> (Box,(Pos,Pos))
subSupScriptBox box0 (y1,box1) (y2,box2) = (box,(pos1,pos2)) where

  box = Box (w,h) outer bound gap 

  pos1 = Pos x (h0+y1) 
  pos2 = Pos x (h0+y2)

  x = max (quadR gap0 - quadL gap1) 
          (quadR gap0 - quadL gap2)

  w = x + max w1 w2
  h = h0

  outer = outer0 <> ofsLUB (pos1,outer1) (pos2,outer2)
  bound = bound0 <> ofsLUB (pos1,bound1) (pos2,bound2)
  gap   = gap0   <> ofsLUB (pos1,  gap1) (pos2,  gap2)

  Box (w0,h0) outer0 bound0 gap0 = box0
  Box (w1,h1) outer1 bound1 gap1 = box1
  Box (w2,h2) outer2 bound2 gap2 = box2

--------------------------------------------------------------------------------
-- * Above and below

-- | Positions are relative!
aboveBelowBox :: Box -> (Pos,Box) -> (Pos,Box) -> (Box,(Pos,Pos))
aboveBelowBox box0 (Pos x1ofs y1ofs, box1) (Pos x2ofs y2ofs, box2) = (box,(pos1,pos2)) where

  box = Box (w,h) outer bound gap 

  Quad (u1,v1) (u2,v2) = bound0

  xc = 0.5 * (u1+u2)

  x1 = xc - 0.5 * w1 + x1ofs - quadL bound1
  x2 = xc - 0.5 * w2 + x2ofs - quadL bound2

  y1 = v1 + y1ofs - quadB bound1
  y2 = v2 + y2ofs - quadT bound2

  pos1 = Pos x1 y1
  pos2 = Pos x2 y2

  w = w0
  h = h0

  outer = outer0 <> ofsLUB (pos1,outer1) (pos2,outer2)
  bound = bound0 <> ofsLUB (pos1,bound1) (pos2,bound2)
  gap   = gap0   <> ofsLUB (pos1,  gap1) (pos2,  gap2)

  Box (w0,h0) outer0 bound0 gap0 = box0
  Box (w1,h1) outer1 bound1 gap1 = box1
  Box (w2,h2) outer2 bound2 gap2 = box2

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