module Graphics.Fig.Values where
import Graphics.Fig.Syntax
import qualified Data.Map as FM
import Data.Maybe
import Data.List
begin_color = "0"
begin_ellipse = "1"
begin_polyline = "2"
begin_spline = "3"
begin_text = "4"
begin_arc = "5"
begin_compound = "6"
begin_comment = "#"
end_compound = "-6"
header_version = "#FIG 3.2"
(toOrientation, fromOrientation) = toFromValue list
where
list =
[ ("Landscape", Landscape)
, ("Portrait", Portrait)
]
(toUnits, fromUnits) = toFromValue list
where
list =
[ ("Metric", Metric)
, ("Inches", Inches)
]
(toPaperSize, fromPaperSize) = toFromValue list
where
list =
[ ("Letter", Letter)
, ("Legal", Legal)
, ("Ledger", Ledger)
, ("Tabloid", Tabloid)
, ("A", A)
, ("B", B)
, ("C", C)
, ("D", D)
, ("E", E)
, ("A4", A4)
, ("A3", A3)
, ("A2", A2)
, ("A1", A1)
, ("A0", A0)
, ("B5", B5)
]
(toMultiplePage, fromMultiplePage) = toFromValue list
where
list =
[ ("Single", Single)
, ("Multiple", Multiple)
]
(toTransparent, fromTransparent) = (to, from)
where
to (3) = Right Background
to (2) = Right None
to (1) = Right TransparentDefault
to n =
either
(const (Left ("Transparency value `" ++ show n ++ "' out of range")))
(Right . Transparent) (toColorSpec n)
from Background = 3
from None = 2
from TransparentDefault = 1
from (Transparent spec) = fromColorSpec spec
(toCoordinateSystem, fromCoordinateSystem) = toFromValue list
where
list = [(1, LowerLeft), (2, UpperLeft)]
(toFontFlags, fromFontFlags) = (to, from)
where
to n
| n < 0 || n > 15 = Left ("Font flag `" ++ show n ++ "' out of range")
| otherwise = Right (FontFlags b3 b1 b0, b2)
where
[b0, b1, b2, b3] =
let xs = toBitList n in xs ++ replicate (4 length xs) False
from ps (FontFlags b3 b1 b0) = fromBitList [b0, b1, b2, b3]
where
b2 = case ps of Ps _ -> True ; Latex _ -> False
fromBitList bs =
foldr
(\x acc -> (if x then 1 else 0) + 2 * acc)
0
bs
toBitList n = unfoldr f n
where
f 0 = Nothing
f n = let (rest, bit) = divMod n 2 in Just (bit == 1, rest)
(toFont, fromFont) = (to, from)
where
to ps n =
if ps
then either Left (Right . Ps) (toPsFont n)
else either Left (Right . Latex) (toLatexFont n)
from (Ps font) = fromPsFont font
from (Latex font) = fromLatexFont font
(toPsFont, fromPsFont) = toFromValue list
where
list =
[ (1, PsDefault)
, (0, TimesRoman)
, (1, TimesItalic)
, (2, TimesBold)
, (3, TimesBoldItalic)
, (4, AvantGardeBook)
, (5, AvantGardeBookOblique)
, (6, AvantGardeDemi)
, (7, AvantGardeDemiOblique)
, (8, BookmanLight)
, (9, BookmanLightItalic)
, (10, BookmanDemi)
, (11, BookmanDemiItalic)
, (12, Courier)
, (13, CourierOblique)
, (14, CourierBold)
, (15, CourierBoldOblique)
, (16, Helvetica)
, (17, HelveticaOblique)
, (18, HelveticaBold)
, (19, HelveticaBoldOblique)
, (20, HelveticaNarrow)
, (21, HelveticaNarrowOblique)
, (22, HelveticaNarrowBold)
, (23, HelveticaNarrowBoldOblique)
, (24, NewCenturySchoolbookRoman)
, (25, NewCenturySchoolbookItalic)
, (26, NewCenturySchoolbookBold)
, (27, NewCenturySchoolbookBoldItalic)
, (28, PalatinoRoman)
, (29, PalatinoItalic)
, (30, PalatinoBold)
, (31, PalatinoBoldItalic)
, (32, Symbol)
, (33, ZapfChanceryMediumItalic)
, (34, ZapfDingbats)
]
(toLatexFont, fromLatexFont) = toFromValue list
where
list =
[ (0, LatexDefault)
, (1, Roman)
, (2, Bold)
, (3, Italic)
, (4, SansSerif)
, (5, Typewriter)
]
(toFlipped, fromFlipped) = toFromValue list
where
list = [(0, Normal), (1, Flipped)]
(toArrowStyle, fromArrowStyle) = toFromValue list
where
list = [(0, HollowArrow), (1, FilledArrow)]
(toArrowType, fromArrowType) = toFromValue list
where
list = [(0, Stick), (1, Closed), (2, Indented), (3, Pointed)]
(toCapStyle, fromCapStyle) = toFromValue list
where
list = [(0, Butt), (1, CapRound), (2, Projecting)]
(toJoinStyle, fromJoinStyle) = toFromValue list
where
list = [(0, Miter), (1, JoinRound), (2, Bevel)]
(toLineStyle, fromLineStyle) = toFromValue list
where
list =
[ (1, LineStyleDefault)
, (0, Solid)
, (1, Dashed)
, (2, Dotted)
, (3, DashDotted)
, (4, DashDoubleDotted)
, (5, DashTripleDotted)
]
(toColorSpec, fromColorSpec) = (to, from)
where
to n
| 1 <= n && n <= 31 = toColorSpec' n
| 32 <= n && n <= 543 = Right (UserDefined n)
| otherwise = Left ("Color value `" ++ show n ++ "' out of range")
from (UserDefined n) = n
from spec = fromColorSpec' spec
(toColorSpec', fromColorSpec') = toFromValue list
where
list =
[ (1, ColorSpecDefault)
, (0, Black)
, (1, Blue)
, (2, Green)
, (3, Cyan)
, (4, Red)
, (5, Magenta)
, (6, Yellow)
, (7, White)
, (8, Blue4)
, (9, Blue3)
, (10, Blue2)
, (11, LtBlue)
, (12, Green4)
, (13, Green3)
, (14, Green2)
, (15, Cyan4)
, (16, Cyan3)
, (17, Cyan2)
, (18, Red4)
, (19, Red3)
, (20, Red2)
, (21, Magenta4)
, (22, Magenta3)
, (23, Magenta2)
, (24, Brown4)
, (25, Brown3)
, (26, Brown2)
, (27, Pink4)
, (28, Pink3)
, (29, Pink2)
, (30, Pink)
, (31, Gold)
]
(toAreaFill, fromAreaFill) = (to, from)
where
to n
| n == 1 = Right NoFill
| 0 <= n && n <= 40 = Right (Filled (n * 5))
| 41 <= n && n <= 62 = Right (Pattern (n 41))
| otherwise = Left ("Area fill value `" ++ show n ++ "' out of range")
from NoFill = 1
from (Filled n) = n `div` 5
from (Pattern n) = n + 41
toFromValue list = (toValue, fromValue)
where
toValue x =
case FM.lookup x toFM of
Nothing -> Left (error x)
Just y -> Right y
fromValue x = fromJust (FM.lookup x fromFM)
toFM = FM.fromList list
fromFM = FM.fromList (map inv list)
inv (x, y) = (y, x)
error x =
"expecting one of " ++
concat
(intersperse " "
(map show (FM.keys toFM))) ++ "\n" ++
"got " ++ show x