Box.hs

-- | Boxes are rectangular shapes having a margin and an extra gap between
-- boxes placed next to each other.
--
-- A 'Box' has an /inner box/, and an /outer box/ which is like a margin. 
-- The inner boxes are used for relative placement, while the outer boxes
-- determine the extent. Furthermore, extra gaps between boxes placed next 
-- to each other are supported.
--
-- Boxes has their origin at the top-left corner of their inner box.
-- Absolute boxes ('AbsBox') have an extra offset.
--
-- We use screen-space coordinate system (Y increase downwards).
--

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

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

import Graphics.Rendering.MiniTypeset.Common

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

-- | A (relative) box
data Box = Box
  { _rboxXSize :: !Double
  , _rboxYSize :: !Double
  , _rboxLeftMarg  :: !Double
  , _rboxRightMarg :: !Double
  , _rboxTopMarg   :: !Double
  , _rboxBotMarg   :: !Double
  , _rboxXGap :: !Double          -- ^ gap on the right side
  , _rboxYGap :: !Double          -- ^ gap on the bottom side
  }
  deriving (Show)

emptyBox :: Box
emptyBox = Box 0 0 0 0 0 0 0 0

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

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

-- | 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 = 
  case valign of

    AlignTop -> ( Box w h l r t b hgap vgap , Pos 0 0 , Pos x 0 ) where
      x = w1 + r1 + hgap1 + l2
      t = max t1 t2
      w = x + w2
      h = max h1 h2
      l = l1
      r = r2
      hgap = hgap2
      b    = max (h1 + b1)         (h2 + b2)         -  h
      vgap = max (h1 + b1 + vgap1) (h2 + b2 + vgap2) - (h + b)  

    AlignBottom -> ( Box w h l r t b hgap vgap , Pos 0 y1 , Pos x y2 ) where
      x  = w1 + r1 + hgap1 + l2
      y1 = max 0 (h2 - h1)
      y2 = max 0 (h1 - h2)
      b = max b1 b2
      w = x + w2
      h = max h1 h2
      l = l1
      r = r2
      hgap = hgap2
      t    = max (h1 + t1)    (h2 + t2)     - h
      vgap = max (b1 + vgap1) (b2 + vgap2)  - b  

  where
    Box w1 h1 l1 r1 t1 b1 hgap1 vgap1 = box1
    Box w2 h2 l2 r2 t2 b2 hgap2 vgap2 = 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 = 
  case halign of

    AlignLeft -> ( Box w h l r t b hgap vgap , Pos 0 0 , Pos 0 y ) where
      y = h1 + b1 + vgap1 + t2
      l = max l1 l2
      h = y + h2
      w = max w1 w2
      t = t1
      b = b2
      vgap = vgap2
      r    = max (w1 + r1)         (w2 + r2)         -  w
      hgap = max (w1 + r1 + hgap1) (w2 + r2 + hgap2) - (w + r)  

    AlignRight -> ( Box w h l r t b hgap vgap , Pos x1 0, Pos x2 y ) where
      y  = h1 + b1 + vgap1 + t2
      x1 = max 0 (w2 - w1)
      x2 = max 0 (w1 - w2)
      r = max r1 r2
      h = y + h2
      w = max w1 w2
      t = t1
      b = b2
      vgap = vgap2
      l    = max (w1 + l1)    (w2 + l2)     - w
      hgap = max (r1 + hgap1) (r2 + hgap2)  - r  

  where
    Box w1 h1 l1 r1 t1 b1 hgap1 vgap1 = box1
    Box w2 h2 l2 r2 t2 b2 hgap2 vgap2 = 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)

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