{-# LANGUAGE BangPatterns #-}
module Graphics.Rendering.MiniTypeset.Box where
import Graphics.Rendering.MiniTypeset.Common
data Box = Box
{ _rboxXSize :: !Double
, _rboxYSize :: !Double
, _rboxLeftMarg :: !Double
, _rboxRightMarg :: !Double
, _rboxTopMarg :: !Double
, _rboxBotMarg :: !Double
, _rboxXGap :: !Double
, _rboxYGap :: !Double
}
deriving (Show)
emptyBox :: Box
emptyBox = Box 0 0 0 0 0 0 0 0
data AbsBox = AbsBox
{ _aboxOffset :: !Pos
, _aboxRelBox :: !Box
}
deriving (Show)
instance Translate AbsBox where
translate ofs (AbsBox pos relbox) = AbsBox (ofs+pos) relbox
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
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)