---------------------------------------------------------
-- |
-- Copyright   : (c) alpha 2006
-- License     : BSD-style
--
-- Maintainer  : misc@NOSPAMalpheccar.org
-- Stability   : experimental
-- Portability : portable
--
-- Vertical mode
---------------------------------------------------------
-- #hide
module Graphics.PDF.Typesetting.Vertical (
    VBox(..)
  , VerState(..)
  , verticalPostProcess
  , mkVboxWithRatio
  , strokeVBoxes
  , vglue
  , defaultVerState
  , ParagraphStyle(..)
  , AnyParagraphStyle(..)
 ) where
 
import Graphics.PDF.LowLevel.Types
import Graphics.PDF.Typesetting.Breaking
import Graphics.PDF.Typesetting.Horizontal(horizontalPostProcess,HBox)
import Graphics.PDF.Draw
import Graphics.PDF.Shapes(Rectangle(..))
import Graphics.PDF.Typesetting.Box
import Data.List(foldl')
import Data.Maybe(isJust,fromJust)

data VerState = VerState { baselineskip :: !(PDFFloat,PDFFloat,PDFFloat) -- ^ Default value (12,0.17,0.0)
                         , lineskip :: !(PDFFloat,PDFFloat,PDFFloat) -- ^ Default value (3.0,0.33,0.0)
                         , lineskiplimit :: !PDFFloat -- ^ Default value 2
                         , paraStyle :: !AnyParagraphStyle
                         }
        
defaultVerState :: ParagraphStyle s => s -> VerState                 
defaultVerState s = VerState { baselineskip = (12,0.17,0.0)
                             , lineskip = (3.0,0.33,0.0)
                             , lineskiplimit = 2
                             , paraStyle = AnyParagraphStyle s
                             }

-- | Pair of functions describing the shape of a text areas : horizontal position of each line, vertical top of the area, width of each line
-- First line is 1

data VBox  = Paragraph [Letter] !(Maybe AnyParagraphStyle) !BRState
           | VBox !PDFFloat !PDFFloat !PDFFloat ![VBox] !(Maybe AnyParagraphStyle)
           | VGlue !PDFFloat !PDFFloat !PDFFloat !(Maybe (PDFFloat,PDFFloat)) !(Maybe AnyParagraphStyle)
           | SomeVBox !PDFFloat !BoxDimension !AnyBox !(Maybe AnyParagraphStyle)
           
vglue :: Maybe AnyParagraphStyle
      -> PDFFloat -- ^ Glue height
      -> PDFFloat -- ^ Glue dilatation factor
      -> PDFFloat -- ^ Glue compression factor
      -> PDFFloat -- ^ Glue width
      -> PDFFloat -- ^ Glue delta
      -> VBox
vglue s h y z width delta = VGlue h width delta (Just(y,z)) s

instance Show VBox where
  show (VBox _ _ _ a _) = "(HBox " ++ show a ++ ")"
  show (VGlue a _ _ _ _) = "(HGlue " ++ show a ++ ")"
  show (Paragraph _ _ _) = "(Paragraph)"
  show (SomeVBox _ _ t _) = "(SomeHBox " ++ show t ++ ")"
                         
-- | A line of hboxes with an adjustement ratio required to display the text (generate the PDF command to increase space size)       
--data HLine = HLine !PDFFloat ![HBox] deriving(Show)

mkVboxWithRatio :: PDFFloat -- ^ Adjustement ratio
                -> [VBox]
                -> VBox
mkVboxWithRatio _ [] = SomeVBox 0.0 (0,0,0) (AnyBox NullChar) Nothing
mkVboxWithRatio r l = 
   let w = foldl' (\x y -> x + boxWidthWithRatio y r) 0.0 l
       h = maximum . map boxHeight $ l
       d = maximum . map boxDescent $ l
       addBox (VGlue gw gh gdelta (Just(y,z)) s) (VBox w' h' d' l' s') = VBox w' h' d' (VGlue (glueWidth gw y z r) gh gdelta Nothing s:l') s'
       addBox a (VBox w' h' d' l' s') = VBox w' h' d' (a:l') s'
       addBox _ _ = error "We can add boxes only to an horizontal list"
   in
   -- Add boxes and dilate glues when needing fixing their dimensions after dilatation
   foldr addBox (VBox w h d [] Nothing) l

instance MaybeGlue VBox where
   boxWidthWithRatio (VGlue w _ _ (Just(y,z)) _) r = glueWidth w y z r
   boxWidthWithRatio a _ = boxWidth a

        
-- | Convert pure lines to VBoxes
toVBoxes :: Maybe AnyParagraphStyle
         -> PDFFloat -- ^ Max width
         -> [HBox] -- ^ List of lines
         -> [VBox] -- ^ List of VBoxes
toVBoxes Nothing _ l = map createVBox l
 where
    createVBox a =  SomeVBox 0.0 (boxWidth a,boxHeight a,boxDescent a) (AnyBox a) Nothing

toVBoxes s@(Just style) w l = map createVBoxAndAddKern $ zip [1..] (l )
 where
      createVBoxAndAddKern (nb,a) = 
          let delta = (linePosition style) w nb
          in
          SomeVBox delta (boxWidth a,boxHeight a,boxDescent a) (AnyBox a) s

-- | Create VBoxes. Paragraphs are analyzed and cut into VBoxes. The pragraph style is updated and used
-- to transform the list of letters
verticalPostProcess :: VerState
             -> Int -- ^ Line offset for the text area
             -> Rectangle -- ^ Text area
             -> [VBox] -- ^ List of VBox with paragraphs
             -> [VBox] -- ^ List of VBox where paragraphs have been line broken
verticalPostProcess _ _ _ [] = []
verticalPostProcess pageSettings o rect@(Rectangle xa _ xb _) ((Paragraph l style paraSettings):l') = 
    let (fl,newStyle) = case style of
              Nothing -> (formatList paraSettings (const $ xb-xa) l,Nothing) 
              Just aStyle -> let (style',nl) = paraChange aStyle l 
               in
               (formatList paraSettings (\nb -> (lineWidth style') (xb-xa) nb ) nl,Just style')
    in
    (addInterlineGlue pageSettings . toVBoxes newStyle (xb - xa) . horizontalPostProcess $ fl) ++ verticalPostProcess pageSettings (o + length fl) rect l'
verticalPostProcess pageSettings o rect (a:l') = a:verticalPostProcess pageSettings (o+1) rect l'


notGlue :: VBox -> Bool
notGlue (VGlue _ _ _ _ _) = False
notGlue (Paragraph _ _ _) = False
notGlue _ = True

-- | Get the required style for the interline glue
getInterlineStyle :: VBox -> VBox -> Maybe AnyParagraphStyle
getInterlineStyle (VBox _ _ _ _ (Just s)) (SomeVBox _ _ _ (Just s')) | paraStyleCode s == paraStyleCode s' = Just s
                                                                     | otherwise = Nothing

getInterlineStyle (VBox _ _ _ _ (Just s)) (VBox _ _ _ _ (Just s')) | paraStyleCode s == paraStyleCode s' = Just s
                                                                   | otherwise = Nothing

getInterlineStyle (SomeVBox _ _ _ (Just s)) (SomeVBox _ _ _ (Just s')) | paraStyleCode s == paraStyleCode s' = Just s
                                                                       | otherwise = Nothing

getInterlineStyle (SomeVBox _ _ _ (Just s)) (VBox _ _ _ _ (Just s')) | paraStyleCode s == paraStyleCode s' = Just s
                                                                     | otherwise = Nothing

getInterlineStyle _ _ = Nothing

-- | Get the delta used to position a box with non rectangular shapes
getBoxDelta :: VBox -> PDFFloat
getBoxDelta (Paragraph _ _ _) = 0.0
getBoxDelta (VBox _ _ _ _ _) = 0.0
getBoxDelta (VGlue _ _ delta _ _) = delta
getBoxDelta (SomeVBox delta _ _ _) = delta
           
addInterlineGlue :: VerState -> [VBox] -> [VBox]
addInterlineGlue _ [] = []
addInterlineGlue _ [a] = [a]
addInterlineGlue settings (a:b:l) | notGlue a && notGlue b = 
    let p = boxDescent a
        h = boxHeight b - boxDescent b
        (ba,by,bz) = baselineskip settings
        (lw,ly,lz) = lineskip settings
        li = lineskiplimit settings
        istyle = getInterlineStyle a b
        theWidth = boxWidth a
        theDelta = getBoxDelta a
    in
    if p <= -1000 
        then
            a:addInterlineGlue settings (b:l)
        else
            if ba - p - h >= li
                then
                    a:(vglue istyle (ba-p-h) by bz theWidth theDelta):addInterlineGlue settings (b:l)
                else
                    a:(vglue istyle lw ly lz theWidth theDelta):addInterlineGlue settings (b:l)
                                  | otherwise = a:addInterlineGlue settings (b:l)

instance Box VBox where
     boxWidth (Paragraph _ _ _) = 0
     boxWidth (VBox w _ _ _ _) = w
     boxWidth (SomeVBox _ d _ _)  = boxWidth d
     boxWidth (VGlue _ w _ _ _)  = w
                  
     boxHeight (Paragraph _ _ _) = 0
     boxHeight (VBox _ h _ _ _) = h
     boxHeight (SomeVBox _ d _ _) = boxHeight d
     boxHeight (VGlue h _ _ _ _) = h
    
     boxDescent (Paragraph _ _ _) = 0
     boxDescent (VBox _ _ d _ _) = d
     boxDescent (SomeVBox _ d _ _) = boxDescent d
     boxDescent (VGlue _ _ _ _ _) = 0

instance DisplayableBox VBox where
          strokeBox (Paragraph _ _ _) _ _ = return ()
          strokeBox b@(VBox _ _ _ l _) x y'' = strokeVBoxes l (x,y',y'')
            where
                y' = y'' - boxHeight b
          strokeBox (VGlue h w delta _ (Just style)) x y = 
              if (isJust . interline $ style)
                  then
                      (fromJust . interline $ style) $ Rectangle (x+delta) (y-h) (x+w+delta) y
                  else
                     return()
          strokeBox (VGlue _ _ _ _ _) _ _ = return ()
          
          strokeBox (SomeVBox delta _ a _) x y = strokeBox a (x+delta) y
 
isSameParaStyle :: AnyParagraphStyle -> VBox -> Bool
isSameParaStyle s (Paragraph _ (Just s') _) = paraStyleCode s == paraStyleCode s'
isSameParaStyle s (VBox _ _ _ _ (Just s')) = paraStyleCode s == paraStyleCode s'
isSameParaStyle s (VGlue _ _ _ _ (Just s')) = paraStyleCode s == paraStyleCode s'
isSameParaStyle s (SomeVBox _ _ _ (Just s'))  = paraStyleCode s == paraStyleCode s'     
isSameParaStyle _ _ = False
     
recurseStrokeVBoxes :: Int -> [VBox] -> (PDFFloat,PDFFloat,PDFFloat) -> Draw ()
recurseStrokeVBoxes _ [] _  = return ()
recurseStrokeVBoxes _ (Paragraph _ _ _:_) _  = return ()
recurseStrokeVBoxes nb (a@(VGlue _ _ _ _ _):l) (xa,y',y)  = do
    let h = boxHeight a
    strokeBox a xa y
    if y - h >= y'
      then
        recurseStrokeVBoxes nb l (xa,y',(y-h))
      else
        return ()
    
recurseStrokeVBoxes nb (a:l) (xa,y',y) = do
    let h = boxHeight a
    strokeBox a xa y
    if y - h >= y'
     then
       recurseStrokeVBoxes (nb+1) l (xa,y',(y-h))
     else
       return ()           
               
drawWithParaStyle :: AnyParagraphStyle -> [VBox] -> (PDFFloat,PDFFloat,PDFFloat) -> Draw ()   
drawWithParaStyle style b (xa,y',y'') = do
    let  (l',l'') = span (isSameParaStyle style) b
         h' = foldl' (\x' ny -> x' + boxHeight ny) 0.0 l'
    if (isJust . paragraphStyle $ style)
      then do
          let xleft = (minimum $ 100000:map getBoxDelta l' ) + xa
              xright = (maximum $ 0:(map (\x -> boxWidth x + getBoxDelta x) l')) + xa
          (fromJust . paragraphStyle $ style) (Rectangle xleft (y''- h') xright (y'')) (recurseStrokeVBoxes 1 l' (xa,y',y''))
      else
         recurseStrokeVBoxes 1 l' (xa,y',y'')
    strokeVBoxes l'' (xa,y',y''-h')
               
-- | Stroke the VBoxes
strokeVBoxes :: [VBox] -- ^ List of boxes
             -> (PDFFloat,PDFFloat,PDFFloat)
             -> Draw ()
strokeVBoxes [] (_,_,_) = return ()
strokeVBoxes b@((Paragraph _ (Just s') _):_) (xa,y',y'') = drawWithParaStyle s' b (xa,y',y'')
strokeVBoxes b@((VBox _ _ _ _ (Just s')):_) (xa,y',y'') = drawWithParaStyle s' b (xa,y',y'')
strokeVBoxes b@((VGlue _ _ _ _ (Just s')):_) (xa,y',y'') = drawWithParaStyle s' b (xa,y',y'')
strokeVBoxes b@((SomeVBox _ _ _ (Just s')):_) (xa,y',y'') = drawWithParaStyle s' b (xa,y',y'')
strokeVBoxes (a:l) (xa,y',y'') = 
    do
        let h = boxHeight a
        strokeBox a xa y''
        if y'' - h >= y'
          then
             strokeVBoxes l (xa,y',(y''-h))
          else
             return ()

-- | Paragraph style
class ParagraphStyle a where
    -- | Width of the line of the paragraph
    lineWidth :: a -- ^ The style
               -> PDFFloat -- ^ Width of the text area used by the typesetting algorithm
               -> Int -- ^ Line number
               -> PDFFloat -- ^ Line width
    
    -- | Horizontal shift of the line position relatively to the left egde of the paragraph bounding box
    linePosition :: a -- ^ The style 
                  -> PDFFloat -- ^ Width of the text area used by the typesetting algorithm
                  -> Int -- ^ Line number 
                  -> PDFFloat -- ^ Horizontal offset from the left edge of the text area
    
    -- | All paragraph styles used in a document must have different codes
    paraStyleCode :: a -- ^ The style 
                  -> Int -- ^ Code identifying the style
    
    -- | How to style the interline glues added in a paragraph by the line breaking algorithm
    interline :: a -- ^ The style 
              -> Maybe (Rectangle -> Draw ()) -- ^ Function used to style interline glues
    interline _ = Nothing
    lineWidth _ w _ = w
    linePosition _ _ = const 0.0
    
    -- | Change the content of a paragraph before the line breaking algorithm is run. It may also change the style
    paraChange :: a -- ^ The style
               -> [Letter] -- ^ List of letters in the paragraph
               -> (a,[Letter]) -- ^ Update style and list of letters
    paraChange a l = (a,l)
    
    -- | Get the paragraph bounding box and the paragraph draw command to apply additional effects
    paragraphStyle :: a -- ^ The style 
                   -> Maybe (Rectangle -> Draw b -> Draw ()) -- ^ Function used to style a paragraph
    paragraphStyle _ = Nothing
    
-- | Any paragraph style
data AnyParagraphStyle = forall a . ParagraphStyle a => AnyParagraphStyle a

instance ParagraphStyle AnyParagraphStyle where
    lineWidth (AnyParagraphStyle a) = lineWidth a
    linePosition (AnyParagraphStyle a) = linePosition a
    paraStyleCode (AnyParagraphStyle a) = paraStyleCode a
    interline (AnyParagraphStyle a) = interline a
    paraChange (AnyParagraphStyle a) l = let (a',l') = paraChange a l in (AnyParagraphStyle a',l')
    paragraphStyle (AnyParagraphStyle a) = paragraphStyle a