-- -- Copyright (c) 2010 Anders Lau Olsen. -- See LICENSE file for terms and conditions. -- -- | Abstract syntax for the FIG format. -- -- For the meaning of the different syntax elements, refer to the FIG format -- description () and the Xfig user -- interface itself. module Graphics.Fig.Syntax where ---------------------------------------------------------------------- -- Fig ---------------------------------------------------------------------- data Fig = Fig { fig_header :: Header , fig_colors :: [Commented Color] , fig_objects :: [Commented Object] } deriving (Show, Eq) ---------------------------------------------------------------------- -- Header ---------------------------------------------------------------------- data Header = Header { header_orientation :: Orientation , header_justification :: Justification , header_units :: Units , header_papersize :: PaperSize , header_magnification :: Double , header_multiple_page :: MultiplePage , header_transparent_color :: Transparent , header_comment :: [String] , header_resolution :: Integer , header_coord_system :: CoordinateSystem } deriving (Show, Eq) data Orientation = Landscape | Portrait deriving (Show, Eq, Ord) data Justification = Center | FlushLeft deriving (Show, Eq) data Units = Metric | Inches deriving (Show, Eq, Ord) data PaperSize = Letter | Legal | Ledger | Tabloid | A | B | C | D | E | A4 | A3 | A2 | A1 | A0 | B5 deriving (Show, Eq, Ord) data MultiplePage = Single | Multiple deriving (Show, Eq, Ord) data Transparent = Background | None | TransparentDefault | Transparent ColorSpec deriving (Show, Eq) data CoordinateSystem = LowerLeft | UpperLeft deriving (Show, Eq, Ord) ---------------------------------------------------------------------- -- Comments ---------------------------------------------------------------------- data Commented a = Comment [String] a deriving (Show, Eq) ---------------------------------------------------------------------- -- Colors ---------------------------------------------------------------------- data Color = Color { color_number :: Integer , color_rgb_values :: String } deriving (Show, Eq) ---------------------------------------------------------------------- -- Objects ---------------------------------------------------------------------- data Object = Text { text_sub_type :: Integer , text_color :: ColorSpec , text_depth :: Integer , text_pen_style :: Integer , text_font :: Font , text_font_size :: Double , text_angle :: Double , text_font_flags :: FontFlags , text_height :: Double , text_length :: Double , text_x :: Integer , text_y :: Integer , text_string :: String } | Arc ArcLine (Maybe Arrow) (Maybe Arrow) | Spline SplineLine (Maybe Arrow) (Maybe Arrow) [(Integer, Integer)] [Double] | Ellipse { ellipse_common :: Common , ellipse_direction :: Integer , ellipse_angle :: Double , ellipse_center_x :: Integer , ellipse_center_y :: Integer , ellipse_radius_x :: Integer , ellipse_radius_y :: Integer , ellipse_start_x :: Integer , ellipse_start_y :: Integer , ellipse_end_x :: Integer , ellipse_end_y :: Integer } | Compound CompoundLine [Commented Object] | Polyline PolylineLine (Maybe Arrow) (Maybe Arrow) (Maybe Pic) [(Integer, Integer)] deriving (Show, Eq) ---------------------------------------------------------------------- -- Starting lines of multiline objects ---------------------------------------------------------------------- data ArcLine = ArcLine { arc_common :: Common , arc_cap_style :: CapStyle , arc_direction :: Integer , arc_center_x :: Double , arc_center_y :: Double , arc_x1 :: Integer , arc_y1 :: Integer , arc_x2 :: Integer , arc_y2 :: Integer , arc_x3 :: Integer , arc_y3 :: Integer } deriving (Show, Eq) data SplineLine = SplineLine { spline_common :: Common , spline_cap_style :: CapStyle } deriving (Show, Eq) data PolylineLine = PolylineLine { polyline_common :: Common , polyline_join_style :: JoinStyle , polyline_cap_style :: CapStyle , polyline_radius :: Integer } deriving (Show, Eq) data CompoundLine = CompoundLine { compound_upperleft_corner_x :: Integer , compound_upperleft_corner_y :: Integer , compound_lowerright_corner_x :: Integer , compound_lowerright_corner_y :: Integer } deriving (Show, Eq) ---------------------------------------------------------------------- -- Fields common for arcs, splines, polylines and ellipses. ---------------------------------------------------------------------- data Common = Common { sub_type :: Integer , line_style :: LineStyle , line_thickness :: Integer , pen_color :: ColorSpec , fill_color :: ColorSpec , depth :: Integer , pen_style :: Integer , area_fill :: AreaFill , style_val :: Double } deriving (Show, Eq) ---------------------------------------------------------------------- -- Arrows ---------------------------------------------------------------------- data Arrow = Arrow { arrow_type :: ArrowType , arrow_style :: ArrowStyle , arrow_thickness :: Double , arrow_width :: Double , arrow_height :: Double } deriving (Show, Eq) data ArrowStyle = HollowArrow | FilledArrow deriving (Show, Eq, Ord) data ArrowType = Stick | Closed | Indented | Pointed deriving (Show, Eq, Ord) ---------------------------------------------------------------------- -- Pictures ---------------------------------------------------------------------- data Pic = Pic { pic_flipped :: Flipped , pic_file :: String } deriving (Show, Eq) data Flipped = Normal | Flipped deriving (Show, Eq, Ord) ---------------------------------------------------------------------- -- Different styles of lines ---------------------------------------------------------------------- data CapStyle = Butt | CapRound | Projecting deriving (Show, Eq, Ord) data JoinStyle = Miter | JoinRound | Bevel deriving (Show, Eq, Ord) data LineStyle = LineStyleDefault | Solid | Dashed | Dotted | DashDotted | DashDoubleDotted | DashTripleDotted deriving (Show, Eq, Ord) ---------------------------------------------------------------------- -- Fonts ---------------------------------------------------------------------- data Font = Latex LatexFont | Ps PsFont deriving (Show, Eq, Ord) data LatexFont = LatexDefault | Roman | Bold | Italic | SansSerif | Typewriter deriving (Show, Eq, Ord) data PsFont = PsDefault | TimesRoman | TimesItalic | TimesBold | TimesBoldItalic | AvantGardeBook | AvantGardeBookOblique | AvantGardeDemi | AvantGardeDemiOblique | BookmanLight | BookmanLightItalic | BookmanDemi | BookmanDemiItalic | Courier | CourierOblique | CourierBold | CourierBoldOblique | Helvetica | HelveticaOblique | HelveticaBold | HelveticaBoldOblique | HelveticaNarrow | HelveticaNarrowOblique | HelveticaNarrowBold | HelveticaNarrowBoldOblique | NewCenturySchoolbookRoman | NewCenturySchoolbookItalic | NewCenturySchoolbookBold | NewCenturySchoolbookBoldItalic | PalatinoRoman | PalatinoItalic | PalatinoBold | PalatinoBoldItalic | Symbol | ZapfChanceryMediumItalic | ZapfDingbats deriving (Show, Eq, Ord) data FontFlags = FontFlags { hidden :: Bool , special :: Bool , rigid :: Bool } deriving (Show, Eq) ---------------------------------------------------------------------- -- Pen and fill colors ---------------------------------------------------------------------- data ColorSpec = ColorSpecDefault | Black | Blue | Green | Cyan | Red | Magenta | Yellow | White | Blue4 | Blue3 | Blue2 | LtBlue | Green4 | Green3 | Green2 | Cyan4 | Cyan3 | Cyan2 | Red4 | Red3 | Red2 | Magenta4 | Magenta3 | Magenta2 | Brown4 | Brown3 | Brown2 | Pink4 | Pink3 | Pink2 | Pink | Gold | UserDefined Integer deriving (Show, Eq, Ord) ---------------------------------------------------------------------- -- Area fill ---------------------------------------------------------------------- data AreaFill = NoFill | Filled Integer | -- Range 0-200 in steps of 5 Pattern Integer -- Range 0-21 deriving (Show, Eq, Ord)