wumpus-core-0.50.0: src/Wumpus/Core/GraphicProps.hs
{-# OPTIONS -Wall #-}
--------------------------------------------------------------------------------
-- |
-- Module : Wumpus.Core.GraphicProps
-- Copyright : (c) Stephen Tetley 2009-2011
-- License : BSD3
--
-- Maintainer : stephen.tetley@gmail.com
-- Stability : unstable
-- Portability : GHC
--
-- Data types for stroke and label styles corresponding to the
-- styles provided by PostScript / SVG (@StrokeAttr@, etc.).
--
-- Data types for annotating Primitives with their drawing style
-- (@PathProps@, etc.). Wumpus represents pictures as trees and
-- decorates all elements (paths, text-labels) with their drawing
-- style. This is boardly similar to how SVG handles attributes.
-- For PostScript output, Wumpus renders attribute changes as
-- graphics state updates.
--
--------------------------------------------------------------------------------
module Wumpus.Core.GraphicProps
(
-- * Stroke attributes
StrokeAttr(..)
, LineCap(..)
, LineJoin(..)
, DashPattern(..)
-- * Font attributes
, FontAttr(..)
, FontFace(..)
, SVGFontStyle(..)
-- * Drawing styles for Primitives
, PathProps(..)
, LabelProps(..)
, EllipseProps(..)
-- * Defaults
, default_stroke_attr
, defaultFont
, wumpus_default_font
) where
import Wumpus.Core.Colour
import Wumpus.Core.Text.Base
import Wumpus.Core.Text.StandardEncoding
import Wumpus.Core.Utils.FormatCombinators
-- | Stroke attributes for drawing paths.
--
data StrokeAttr = StrokeAttr
{ line_width :: Double
, miter_limit :: Double
, line_cap :: LineCap
, line_join :: LineJoin
, dash_pattern :: DashPattern
}
deriving (Eq,Show)
-- | Line cap - default in output is butt.
--
data LineCap = CapButt | CapRound | CapSquare
deriving (Enum,Eq,Show)
-- | Line join - default in output is miter.
--
data LineJoin = JoinMiter | JoinRound | JoinBevel
deriving (Enum,Eq,Show)
-- | Dash pattern - either a solid line or a list of on-off pairs
-- together with an /offset/ into the dashes.
--
data DashPattern = Solid | Dash Int [(Int,Int)]
deriving (Eq,Show)
-- | Font face and size. Equivalent fonts have different names
-- in PostScript and SVG. A PostScript font name includes the
-- font style (e.g. @Times-BoldItalic@) whereas an SVG font has
-- a name (the @font-family@ attribute) and a style.
--
-- For PostScript, the following fonts are expected to exist on
-- most platforms:
--
-- > Times-Roman Times-Italic Times-Bold Times-BoldOtalic
-- > Helvetica Helvetica-Oblique Helvetica-Bold Helvetica-Bold-Oblique
-- > Courier Courier-Oblique Courier-Bold Courier-Bold-Oblique
-- > Symbol
--
-- See the PostScript Language Reference Manual.
--
data FontAttr = FontAttr
{ font_size :: Int
, font_face :: FontFace
}
deriving (Eq,Ord,Show)
-- | 'FontFace' : @ postscript_name * svg_font_family * svg_font_style
-- * encoding_vector @
--
-- For the writing fonts in the Core 14 set the definitions are:
--
-- > "Times-Roman" "Times New Roman" SVG_REGULAR standard_encoding
-- > "Times-Italic" "Times New Roman" SVG_ITALIC standard_encoding
-- > "Times-Bold" "Times New Roman" SVG_BOLD standard_encoding
-- > "Times-BoldItalic" "Times New Roman" SVG_BOLD_ITALIC standard_encoding
-- >
-- > "Helvetica" "Helvetica" SVG_REGULAR standard_encoding
-- > "Helvetica-Oblique" "Helvetica" SVG_OBLIQUE standard_encoding
-- > "Helvetica-Bold" "Helvetica" SVG_BOLD standard_encoding
-- > "Helvetica-Bold-Oblique" "Helvetica" SVG_BOLD_OBLIQUE standard_encoding
-- >
-- > "Courier" "Courier New" SVG_REGULAR standard_encoding
-- > "Courier-Oblique" "Courier New" SVG_OBLIQUE standard_encoding
-- > "Courier-Bold" "Courier New" SVG_BOLD standard_encoding
-- > "Courier-Bold-Oblique" "Courier New" SVG_BOLD_OBLIQUE standard_encoding
--
data FontFace = FontFace
{ ps_font_name :: String
, svg_font_family :: String
, svg_font_style :: SVGFontStyle
, font_enc_vector :: EncodingVector
}
deriving (Eq,Ord,Show)
-- | SVG font styles - potentially a style may generate both
-- @font-weight@ and @font-style@ attributes in the SVG output.
--
data SVGFontStyle = SVG_REGULAR | SVG_BOLD | SVG_ITALIC | SVG_BOLD_ITALIC
| SVG_OBLIQUE | SVG_BOLD_OBLIQUE
deriving (Eq,Ord,Show)
--------------------------------------------------------------------------------
-- | Note when drawn /filled/ and drawn /stroked/ the same
-- polygon will have (slightly) different size:
--
-- * A filled shape fills /within/ the boundary of the shape
--
-- * A stroked shape draws a pen line around the boundary
-- of the shape. The actual size depends on the thickness
-- of the line (stroke width).
--
data PathProps = CFill RGBi
| CStroke StrokeAttr RGBi
| OStroke StrokeAttr RGBi
-- Note - first colour fill, second colur stroke.
| CFillStroke RGBi StrokeAttr RGBi
deriving (Eq,Show)
-- | Font rendering properties for a PrimLabel.
--
data LabelProps = LabelProps
{ label_colour :: RGBi
, label_font :: FontAttr
}
deriving (Eq,Ord,Show)
-- | Ellipses and circles are always closed.
--
data EllipseProps = EFill RGBi
| EStroke StrokeAttr RGBi
-- Note - first colour fill, second colour stroke.
| EFillStroke RGBi StrokeAttr RGBi
deriving (Eq,Show)
--------------------------------------------------------------------------------
instance Format PathProps where
format (CFill rgb) = format rgb <+> text "Fill"
format (CStroke _ rgb) = format rgb <+> text "Closed-stroke"
format (OStroke _ rgb) = format rgb <+> text "Open-stroke"
format (CFillStroke f _ s) = format f <+> text "Fill" <> char '/'
<+> format s <+> text "Stroke"
instance Format LabelProps where
format (LabelProps rgb attr) = format rgb
<+> text (ps_font_name $ font_face attr)
instance Format EllipseProps where
format (EFill rgb) = format rgb <+> text "Fill"
format (EStroke _ rgb) = format rgb <+> text "Stroke"
format (EFillStroke f _ s) = format f <+> text "Fill" <> char '/'
<+> format s <+> text "Stroke"
--------------------------------------------------------------------------------
-- Defaults
-- | Default stroke attributes.
--
-- > line_width = 1
-- > miter_limit = 1
-- > line_cap = CapButt
-- > line_join = JoinMiter
-- > dash_pattern = Solid
--
default_stroke_attr :: StrokeAttr
default_stroke_attr = StrokeAttr { line_width = 1
, miter_limit = 1
, line_cap = CapButt
, line_join = JoinMiter
, dash_pattern = Solid
}
-- | 'defaultFont' :@ font_size -> FontAttr @
--
-- Constructor for the default font, which is @Courier@ (aliased
-- to @Courier New@ for SVG) at the supplied size.
--
-- Note - the font uses the Standard encoding - this is common to
-- fonts but uses different indices to the more common Latin1.
--
-- For instance 232 is Lslash not egrave.
--
-- Both GhostScript and the standard AFM /Core 14/ metrics
-- supplied by Adobe use Standard Encoding but include further
-- characters (e.g. egrave) in the non-indexed /higher-region/.
--
defaultFont :: Int -> FontAttr
defaultFont sz = FontAttr sz face
where
face = FontFace { ps_font_name = "Courier"
, svg_font_family = "Courier New"
, svg_font_style = SVG_REGULAR
, font_enc_vector = standard_encoding
}
-- | Constant for the default font (@Courier@) at 14 point.
--
wumpus_default_font :: FontAttr
wumpus_default_font = defaultFont 14