--
-- Copyright (c) 2004 Anders Lau Olsen.
-- See LICENSE file for terms and conditions.
--

-- | Pretty printer for the FIG format.
module Graphics.Fig.Printer (pretty) where

import Graphics.Fig.Syntax
import Graphics.Fig.Values

import Text.PrettyPrint.HughesPJ

----------------------------------------------------------------------
-- Type declarations of exported functions
----------------------------------------------------------------------

-- | Convert a figure to a string in the FIG format.
pretty
    :: Fig -- ^A figure.
    -> String -- ^The figure in FIG format.

----------------------------------------------------------------------
-- The pretty printer
----------------------------------------------------------------------

pretty tree = show (fig tree)

----------------------------------------------------------------------
-- Fig
----------------------------------------------------------------------

fig (Fig h cls objs) =
    header h $+$
    colors cls $+$
    objects objs $+$
    text ""

----------------------------------------------------------------------
-- Header
----------------------------------------------------------------------

header (Header h1 h2 h3 h4 h5 h6 h7 h8 h9 h10) =
    vcat
        [ text header_version
        , doc h1
        , doc h2
        , doc h3
        , doc h4
        , doc h5
        , doc h6
        , doc h7
        , commentStrings h8
        , doc h9 <+> doc h10
        ]

----------------------------------------------------------------------
-- Comments
----------------------------------------------------------------------

commented doc (Comment cs obj) =
    commentStrings cs $+$
    doc obj

commentStrings lines = vcat (map commentLine lines)

commentLine line = text ('#' : line)

----------------------------------------------------------------------
-- Colors
----------------------------------------------------------------------

colors cls = vcat (map (commented color) cls)

color (Color c1 c2) =
    hsep
        [ text begin_color
        , doc c1
        , text c2
        ]

----------------------------------------------------------------------
-- Objects
----------------------------------------------------------------------

objects objs = vcat (map (commented object) objs)

object o =
    case o of
        Arc line fw bw ->
            arcLine line fw bw $+$
            indent (maybeArrow fw) $+$
            indent (maybeArrow bw)
        Ellipse common e10 e11 e12 e13 e14 e15 e16 e17 e18 e19 ->
            hsep
                [ text begin_ellipse
                , commonLine common
                , doc e10
                , doc e11
                , doc e12
                , doc e13
                , doc e14
                , doc e15
                , doc e16
                , doc e17
                , doc e18
                , doc e19
                ]
        Polyline polyline fw bw pic pts ->
            polylineLine polyline fw bw pts $+$
            indent (maybeArrow fw) $+$
            indent (maybeArrow bw) $+$
            indent (maybePic pic) $+$
            indent (hsep (map point pts))
        Spline spline fw bw pts ctrl ->
            splineLine spline fw bw pts $+$
            indent (maybeArrow fw) $+$
            indent (maybeArrow bw) $+$
            indent (hsep (map point pts)) $+$
            indent (hsep (map doc ctrl))
        Text t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13->
            hsep
                [ text begin_text
                , doc t1
                , doc t2
                , doc t3
                , doc t4
                , doc t5
                , doc t6
                , doc t7
                , doc (fromFontFlags t5 t8)
                , doc t9
                , doc t10
                , doc t11
                , doc t12
                , text t13 <> text "\\001"
                ]
        Compound line objs ->
            compoundLine line $+$
            objects objs $+$
            text end_compound

----------------------------------------------------------------------
-- Compound starting line
----------------------------------------------------------------------

compoundLine (CompoundLine c1 c2 c3 c4) =
    hsep
        [ text begin_compound
        , doc c1
        , doc c2
        , doc c3
        , doc c4
        ]

----------------------------------------------------------------------
-- Arc starting line
----------------------------------------------------------------------

arcLine
    (ArcLine common a10 a11 a14 a15 a16 a17 a18 a19 a20 a21) fw bw =
    hsep
        [ text begin_arc
        , commonLine common
        , doc a10
        , doc a11
        , arrowFlag fw
        , arrowFlag bw
        , doc a14
        , doc a15
        , doc a16
        , doc a17
        , doc a18
        , doc a19
        , doc a20
        , doc a21
        ]

----------------------------------------------------------------------
-- Spline starting line
----------------------------------------------------------------------

splineLine (SplineLine common s10) fw bw npoints =
    hsep
        [ text begin_spline
        , commonLine common
        , doc s10
        , arrowFlag fw
        , arrowFlag bw
        , doc (length npoints)
        ]

----------------------------------------------------------------------
-- Polyline starting line
----------------------------------------------------------------------

polylineLine (PolylineLine common p10 p11 p12) fw bw npoints =
    hsep
        [ text begin_polyline
        , commonLine common
        , doc p10
        , doc p11
        , doc p12
        , arrowFlag fw
        , arrowFlag bw
        , doc (length npoints)
        ]

point (x, y) = doc x <+> doc y

----------------------------------------------------------------------
-- Pictures
----------------------------------------------------------------------

pic (Pic p1 p2) = doc p1 <+> text p2

maybePic p = maybe empty pic p

----------------------------------------------------------------------
-- Arrows
----------------------------------------------------------------------

arrow (Arrow a1 a2 a3 a4 a5) =
    hsep
        [ doc a1
        , doc a2
        , doc a3
        , doc a4
        , doc a5
        ]

maybeArrow a = maybe empty arrow a

arrowFlag Nothing = text "0"
arrowFlag (Just _) = text "1"

----------------------------------------------------------------------
-- The fields common for arcs, splines, polylines, and ellipses.
----------------------------------------------------------------------

commonLine (Common p1 p2 p3 p4 p5 p6 p7 p8 p9) =
    hsep
        [ doc p1
        , doc p2
        , doc p3
        , doc p4
        , doc p5
        , doc p6
        , doc p7
        , doc p8
        , doc p9
        ]

----------------------------------------------------------------------
-- Utilities
----------------------------------------------------------------------

indent doc = nest 8 doc

class Docable a where
    doc :: a -> Doc

instance Docable Int where doc = text . show
instance Docable Integer where doc = text . show
instance Docable Double where doc = text . show

instance Docable Orientation where doc = text . fromOrientation
instance Docable Units where doc = text . fromUnits
instance Docable PaperSize where doc = text . fromPaperSize
instance Docable MultiplePage where doc = text . fromMultiplePage

instance Docable Justification where
    doc Center = text "Center"
    doc FlushLeft = text "Flush Left"

instance Docable LineStyle where doc = doc . fromLineStyle
instance Docable JoinStyle where doc = doc . fromJoinStyle
instance Docable CapStyle where doc = doc . fromCapStyle
instance Docable Flipped where doc = doc . fromFlipped
instance Docable ArrowType where doc = doc . fromArrowType
instance Docable ArrowStyle where doc = doc . fromArrowStyle
instance Docable ColorSpec where doc = doc . fromColorSpec
instance Docable AreaFill where doc = doc . fromAreaFill
instance Docable Transparent where doc = doc . fromTransparent
instance Docable CoordinateSystem where doc = doc . fromCoordinateSystem
instance Docable Font where doc = doc . fromFont