wumpus-core 0.33.0 → 0.34.0

raw patch · 16 files changed

+152/−116 lines, 16 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• demo/Latin1Pic.hs +4/−2
• src/Wumpus/Core.hs +7/−38
• src/Wumpus/Core/AffineTrans.hs +17/−10
• src/Wumpus/Core/BoundingBox.hs +1/−2
• src/Wumpus/Core/Colour.hs +6/−3
• src/Wumpus/Core/FontSize.hs +8/−6
• src/Wumpus/Core/GraphicsState.hs +4/−12
• src/Wumpus/Core/OutputPostScript.hs +12/−2
• src/Wumpus/Core/OutputSVG.hs +7/−9
• src/Wumpus/Core/Picture.hs +5/−1
• src/Wumpus/Core/PictureInternal.hs +15/−13
• src/Wumpus/Core/SVGDoc.hs +8/−1
• src/Wumpus/Core/TextInternal.hs +41/−12
• src/Wumpus/Core/VersionNumber.hs +2/−2
• src/Wumpus/Core/WumpusTypes.hs +1/−1
• wumpus-core.cabal +14/−2

@@ -20,8 +20,10 @@ -- supports escapes as either numbers or names... -- pic1 :: DPicture-pic1 = frame [ helveticaLabel "mystère"      (P2 0 40)-             , helveticaLabel "myst&#egrave;re"   (P2 0 20)+pic1 = frame [ helveticaLabel "mystère"      (P2 0 60)+             , helveticaLabel "myst&#egrave;re"   (P2 0 40)+             , helveticaLabel "myst&#0o350;re"    (P2 0 20)+             , helveticaLabel "myst&#0XE8;re"     (P2 0 00)              ]   

@@ -12,46 +12,15 @@ -- -- Common interface to Wumpus.Core. ----- This module re-exports types and functions from:------ * "Wumpus.Core.AffineTrans"------ * "Wumpus.Core.BoundingBox"------ * "Wumpus.Core.Colour"------ * "Wumpus.Core.FontSize"------ * "Wumpus.Core.Geometry"------ * "Wumpus.Core.GraphicsState"------ * "Wumpus.Core.OutputPostScript"------ * "Wumpus.Core.OutputSVG"------ * "Wumpus.Core.Picture"------ * "Wumpus.Core.PictureLanguage"------ * "Wumpus.Core.PtSize"------ * "Wumpus.Core.TextEncoder"------ * "Wumpus.Core.TextLatin1"------ * "Wumpus.Core.TextSymbolFont"------ * "Wumpus.Core.VersionNumber"------ * "Wumpus.Core.WumpusTypes"+-- This is a /shim/ module re-exporting types and functions from+-- the exposed Wumpus-Core modules. In most cases, importing just +-- this module should be sufficient to use Wumpus-Core.  ----- Named colours ( black, white etc.) are hidden from +-- Named colours ( black, white etc.) are hidden from the module -- "Wumpus.Core.Colour" to avoid collisions with modules that--- define colour sets (e.g. all the SVG colours). If needed, --- the module can be imported directly.--- ---+-- define colour sets (e.g. all the SVG colours). If named +-- colours are needed, "Wumpus.Core.Colour" can be imported +-- directly. --  -------------------------------------------------------------------------------- 

@@ -18,16 +18,23 @@ -- The common affine transformations represented as type classes - -- scaling, rotation, translation. ----- Unlike other functional graphics systems (e.g. Clastic), Wumpus--- performs the affine transformations as matrix operations. This --- simplifies the implementation of pictures --- ("Wumpus.Core.PictureInternal"). When a picture is composed and --- transformed, transformations will be performed only on the --- bounding box in Wumpus but the transformation of the --- picture content (paths or text labels) will be communicated to --- PostScript or SVG to render. This is because Wumpus has no --- access to the paths that make fonts so cannot transform them --- directly.+-- Internally, when a picture is composed and transformed, Wumpus+-- only transforms the bounding box - transformations of the +-- picture content (paths or text labels) are communicated to +-- PostScript or SVG for final rendering. This is because Wumpus +-- has no access to the paths that make fonts so cannot transform +-- them directly.+--+-- As well as Pictures, some elements - e.g. Vectors, Points and +-- BoundingBoxes - are also instances of the affine classes. The+-- implementation of the instances considers that under +-- transformation these objects are implicitly within the standard +-- affine frame (origin at point zero and unit basis vectors for +-- the horizontal and vertical). +--+-- This assumption cannot hold for primitives because text is +-- special in PostScript and SVG, so there are no instances of +-- the affine classes for Primitive or PrimElement. --  -- To generate efficient PostScript, Wumpus relies on the matrix -- representations of the affine transformations being invertible.

@@ -14,8 +14,7 @@ -- Bounding box with no notion of \'empty\'. -- -- Empty pictures cannot be created with Wumpus. This greatly --- simplifies the implementation of pictures themselves and--- bounding boxes.+-- simplifies the implementation of pictures and bounding boxes. --  -------------------------------------------------------------------------------- 

@@ -13,9 +13,12 @@ -- Colour represented as RGB with each component in the range  -- [0..255]. -- --- Note - the predifined colours are hidden when importing the--- /top-level/ module @Wumpus.Core@, import this module directly--- to use them.+-- Note - the predefined colours are hidden when importing the+-- /top-level/ shim module @Wumpus.Core@, import +-- @Wumpus.Core.Colour@ directly to use them.+--+-- PostScript has no support for RGB-alpha and hence does not+-- transparency. Thus Wumpus in turn cannot support transparency. -- -------------------------------------------------------------------------------- 

@@ -13,14 +13,16 @@ -- Font size calculation for Label\'s and their bounding boxes. --  -- Calculations are based on metrics derived from Courier at --- 48pt. As Courier is a monospaced font, bounding boxes --- calculated for other font families will usually have longer --- width than is necessary for the printed text. +-- 48pt. As Courier is a monospaced font, applying these metrics+-- to other font families will usually produce over-estimates+-- (bounding boxes will be longer than the true visual length+-- of the text). --  -- This is a deficiency of Wumpus, and limits its text handling--- capabilities (for example, text cannot be automatically --- centered). However, alternatives would need access to font --- metrics - this would require a font loader and add +-- capabilities - for example, text cannot be reliably centered+-- as its true length is not known. However, more powerful +-- alternatives would need access to the metrics embedded within+-- font files. This would require a font loader and add  -- significant implementation complexity. --  --------------------------------------------------------------------------------

@@ -10,25 +10,17 @@ -- Stability   :  unstable -- Portability :  GHC ----- Data types for stroke and label attributes and type classes --- for conversion to PostScript\'s colour and matrix --- representations. +-- Data types for stroke and label attributes.  --  -- Wumpus represents pictures as trees - a leaf represents a  -- path or text label. All attributes of a path or text label  -- (colour, stroke width, font, ...) are stored in the leaf. So -- a picture is a leaf labelled tree. -- --- By contrast, PostScript maintains a /graphics state/. A +-- By contrast, PostScript maintains a global /graphics state/. A  -- PostScript program is free to modify the graphics state --- anywhere in the program. Stroke width is a general property  --- shared by all elements (initially it has the default value 1).--- Only stroked paths actually regard stroke width, fonts and --- filled and clipping paths ignore it. PostScript allows more --- control over the graphics state by allowing the current state--- to be saved and restored with the @gsave@ and @grestore@. --- This is useful for modularity but is a comparatively expensive--- procedure.+-- anywhere in the program and subsequent elements are all drawn +-- according to the modified graphics state.  -- -- When Wumpus renders Pictures as PostScript it maintains a  -- limited graphics state with just current colour and current 

@@ -98,7 +98,10 @@ setsGS :: (GraphicsState -> GraphicsState) -> PsMonad () setsGS fn = PsMonad $ \_ s -> ((),fn s) +resetGS :: PsMonad ()+resetGS = PsMonad $ \ _ _ -> ((),zeroGS) + setsSA :: (StrokeAttr -> StrokeAttr) -> PsMonad () setsSA fn = getsGS gs_stroke_attr >>= \sa ->              setsGS (\s -> s { gs_stroke_attr = fn sa })@@ -251,12 +254,19 @@ -- Note - PostScript ignotes any FontCtx changes via the @Group@ -- constructor. --+-- Also - because Clip uses gsave grestore it has to resetGS on+-- ending, otherwise the next picture will be diffing against+-- a modified state (in Wumpus land) that contradicts the PostScript +-- state. +-- picture :: (Real u, Floating u, PSUnit u) => Picture u -> PsMonad Doc picture (Leaf    (_,xs) ones)   = bracketTrafos xs $ oneConcat primElement ones picture (Picture (_,xs) ones)   = bracketTrafos xs $ oneConcat picture ones-picture (Clip    (_,xs) cp pic) = bracketTrafos xs $-                                    (vconcat <$> clipPath cp <*> picture pic) picture (Group   (_,xs) _ pic) = bracketTrafos xs (picture pic)+picture (Clip    (_,xs) cp pic) = bracketTrafos xs $+    (\d1 d2 -> vcat [ps_gsave,d1,d2,ps_grestore])+      <$> clipPath cp <*> picture pic <* resetGS+   oneConcat :: (a -> PsMonad Doc) -> OneList a -> PsMonad Doc

@@ -18,14 +18,10 @@ -- 1. The coordinate space of SVG is /origin top-left/, for  -- PostScript it is /origin bottom-left/. -- --- 2. Clipping in PostScript works by changing the graphics state--- Clip a path, then all subsequent drawing be rendered only --- when it is within the clip bounds. Clearly using clipping --- paths within a @gsave ... grestore@ block is a good idea...------ SVG uses /tagging/. A clipPath element is declared and named --- then referenced in subsequent elements via the clip-path --- attribute - @clip-path=\"url(#clip_path_tag)\"@.+-- 2. Clipping in SVG uses /tagging/. A clipPath element is +-- declared and named, subsequent elements within the clipping +-- area reference it via the clip-path attribute - +-- @clip-path=\"url(#clip_path_tag)\"@. -- -- --------------------------------------------------------------------------------@@ -211,7 +207,9 @@ drawXLink (XLink href) doc = elem_a_xlink href doc  clipPath :: PSUnit u => String -> PrimPath u -> SvgMonad Doc-clipPath clip_id pp = (\doc -> elem_clipPath (attr_id clip_id) doc) <$> path pp+clipPath clip_id pp = +    (\doc -> elem_clipPath (attr_id clip_id) (elem_path_no_attrs doc)) +      <$> path pp   primPath :: PSUnit u => PathProps -> PrimPath u -> SvgMonad Doc

@@ -476,9 +476,13 @@ -- neither picture will be moved. -- picOver :: (Num u, Ord u) => Picture u -> Picture u -> Picture u-a `picOver` b = Picture (bb,[]) (cons a $ one b)+a `picOver` b = Picture (bb,[]) (cons b $ one a)    where     bb = boundary a `append` boundary b++-- picOver note - draw b, put b first in the list, so it draws +-- first in the output (this is also @behind@ in the Z-Order).+  -- | 'picMoveBy' : @ picture -> vector -> picture @ -- 

@@ -115,11 +115,8 @@ -- Omitting some details, Picture is a simple non-empty  -- leaf-labelled rose tree via: -- --- > Leaf primitives | Picture [tree]+-- > tree = Leaf [primitive] | Picture [tree] ----- Where OneList is a variant of the standard list type that --- disallows empty lists.---  -- The additional constructors are convenience: -- -- @Clip@ nests a picture (tree) inside a clipping path.@@ -137,10 +134,15 @@ type DPicture = Picture Double  -- | To represent XLink hyperlinks, Primitives in a Leaf are --- encoded in a tree rather a list.+-- actualy encoded in a tree rather a list. ----- (This is rather unfortunate as it expends an extra wrapper--- for ever element regardless of whether hyerlinks are needed).+-- As a design, this is rather unfortunate as it demands an extra +-- wrapper for ever element regardless of whether hyperlinks are +-- actually used. But it does mean that one hyperlink can cover a +-- complex graphic element - for example an arrow might be drawn +-- with one or more paths, plus extra (filled or stroked) paths +-- for the tip and tail, but each element should be within the +-- link.  -- data PrimElement u = Atom             (Primitive u)                    | XLinkGroup XLink (OneList (PrimElement u))@@ -190,8 +192,8 @@   deriving (Eq,Show)                   -- | Wumpus\'s drawings are built from two fundamental --- primitives: paths (line segments and Bezier curves) and --- labels (single lines of text). +-- primitives: paths (straight line segments and Bezier curves) +-- and labels (single lines of text).  --  -- Ellipses are a included as a primitive only for optimization  -- - drawing a reasonable circle with Bezier curves needs at @@ -649,7 +651,7 @@ -- | Rotate a Primitive. --  -- Note - this is not an affine transformation as Primitives are--- not regarded as being in an affine frame.+-- not regarded as being within an affine frame. -- -- * Paths are rotated about their start point. --@@ -679,7 +681,7 @@ -- | Scale a Primitive. --  -- Note - this is not an affine transformation as Primitives are--- not regarded as being in an affine frame.+-- not regarded as being within an affine frame. -- -- An affine scaling uniformly scales all the elements in a  -- Picture. It is just a change of the Picture\'s basis vectors.@@ -749,8 +751,8 @@ --  -- This is a visually intuitive interpretation - Primitives are -- not in an affine space (they have an origin, i.e. the location --- (0,0), but don\'t not basis vectors) so manipulating them --- cannot follow the standard affine interpretation.+-- (0,0), but do not have tangible basis vectors) so manipulating +-- them cannot follow the standard affine interpretation. --  rotatePath :: (Real u, Floating u) => Radian -> PrimPath u -> PrimPath u rotatePath ang (PrimPath start xs) = PrimPath start $ map (mapSeg fn) xs 

@@ -27,6 +27,7 @@   , elem_a_xlink     , elem_clipPath   , elem_path+  , elem_path_no_attrs   , elem_text   , elem_tspan   , elem_ellipse@@ -169,6 +170,12 @@ elem_path attrs path = svgElem "path" (attrs <+> svgAttr "d" path)  +-- | @ \<path d=... /\> @+--+elem_path_no_attrs :: Doc -> Doc+elem_path_no_attrs path = svgElem "path" (svgAttr "d" path)++ -- | @ \<text ... >...\</text\> @ -- elem_text :: Doc -> Doc -> Doc@@ -381,7 +388,7 @@ -- | @ clip_path="url(#...)" @ -- attr_clip_path :: String -> Doc-attr_clip_path ss = svgAttr "transform" (text "url" <> parens (text $ '#':ss)) +attr_clip_path ss = svgAttr "clip-path" (text "url" <> parens (text $ '#':ss))    -- | @ transform="..." @

@@ -125,20 +125,49 @@ --  lexer :: String -> [TextChunk] lexer []            = []+lexer ('&':'#':cs)  = escStart cs+lexer (c:cs)        = let (ss,rest) = span (/= '&') cs +                      in TextSpan (c:ss) : lexer rest -lexer ('&':'#':xs)  = esc xs+escStart :: String -> [TextChunk]+escStart ('0':'o':cs)           = escOct cs+escStart ('0':'O':cs)           = escOct cs+escStart ('0':'x':cs)           = escHex cs+escStart ('0':'X':cs)           = escHex cs+escStart (c:cs) | isDigit c     = escDec (digitToInt c) cs+escStart (c:cs)                 = let (ss,rest) = span isAlphaNum cs +                                  in TextEscName (c:ss) : chompToSemi rest+escStart []                     = [] ++-- | One digit consumed already...+--+escDec :: Int -> String -> [TextChunk]+escDec n (c:cs) | isDigit c = escDec (n*10 + digitToInt c) cs+escDec n cs     | n > 0     = TextEscInt n : chompToSemi cs+                | otherwise = chompToSemi cs++escHex :: String -> [TextChunk]+escHex = step 0   where-    esc (c:cs) | isDigit c = let (s,cs') = span isDigit cs -                             in  intval (c:s) cs'-               | otherwise = let (s,cs') = span isAlpha cs -                             in TextEscName (c:s) : optsemi cs'-    esc []                 = []+    step n (c:cs) | isHexDigit c = step (n*16 + digitToInt c) cs+    step n cs     | n > 0        = TextEscInt n : chompToSemi cs+                  | otherwise    = chompToSemi cs  -    optsemi (';':cs)   = lexer cs      -- let ill-formed go through-    optsemi cs         = lexer cs -    intval [] rest  = optsemi rest-    intval cs rest  = TextEscInt (read cs) : optsemi rest+escOct :: String -> [TextChunk]+escOct = step 0+  where+    step n (c:cs) | isHexDigit c = step (n*8 + digitToInt c) cs+    step n cs     | n > 0        = TextEscInt n : chompToSemi cs+                  | otherwise    = chompToSemi cs  -lexer (x:xs)        = let (s,xs') = span (/= '&') xs -                      in TextSpan (x:s) : lexer xs'+++-- The last two conditions both indicate ill-formed input, but it+-- is /best/ if the lexer does not throw errors.+-- +chompToSemi :: String -> [TextChunk]+chompToSemi (';':cs) = lexer cs+chompToSemi (_:cs)   = chompToSemi cs           +chompToSemi []       = []+

@@ -22,7 +22,7 @@  -- | Version number. ----- > (0,33,0)+-- > (0,34,0) -- wumpus_core_version :: (Int,Int,Int)-wumpus_core_version = (0,33,0)+wumpus_core_version = (0,34,0)

@@ -12,7 +12,7 @@ -- -- This module re-exports types and functions from  -- "Wumpus.Core.PictureInternal" but makes them opaque. -+-- Contructors are provided by "Wumpus.Core.Picture". --  -------------------------------------------------------------------------------- 

@@ -1,5 +1,5 @@ name:             wumpus-core-version:          0.33.0+version:          0.34.0 license:          BSD3 license-file:     LICENSE copyright:        Stephen Tetley <stephen.tetley@gmail.com>@@ -37,7 +37,7 @@   Wumpus might be limited compared to other systems. However,    the design permits a fairly simple implementation, which is a    priority. -  .+  .     .   \[1\] Because the output is simple, straight-line PostScript    code, it is possible to use GraphicsMagick or a similar tool @@ -46,6 +46,18 @@   .   Changelog:   .+  0.33.0 to 0.34.0:+  .+  * Clipping paths fixed. Previously they did not work for SVG or+    PostScript.+  .+  * @picOver@ fixed. Drawing order was changed in version 0.33.0, +    but @picOver@ was not updated accordingly (so it actually +    started drawing pictures /under/). It now works correctly.+  .+  * The lexer for escape characters embedded in label strings has +    been rewritten. It now supports octal and hexadecimal codes.+  .     0.32.0 to 0.33.0:   .   * Major change - reworked support for text encoding. Encoding