wumpus-core 0.31.0 → 0.32.0

raw patch · 25 files changed

+354/−292 lines, 25 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• demo/AffineTest01.hs +2/−2
• demo/AffineTest02.hs +2/−2
• demo/AffineTest03.hs +2/−2
• demo/AffineTestBase.hs +13/−13
• demo/DeltaPic.hs +2/−2
• demo/FontMetrics.hs +4/−4
• demo/KernPic.hs +2/−2
• demo/Latin1Pic.hs +1/−1
• demo/MultiPic.hs +1/−1
• demo/Rotated.hs +6/−6
• demo/Scaled.hs +6/−6
• demo/Translated.hs +6/−6
• demo/ZOrderPic.hs +1/−1
• doc-src/WorldFrame.hs +2/−2
• src/Wumpus/Core.hs +1/−1
• src/Wumpus/Core/Colour.hs +28/−10
• src/Wumpus/Core/FontSize.hs +49/−4
• src/Wumpus/Core/OutputPostScript.hs +10/−4
• src/Wumpus/Core/OutputSVG.hs +8/−6
• src/Wumpus/Core/PageTranslation.hs +8/−4
• src/Wumpus/Core/Picture.hs +68/−163
• src/Wumpus/Core/PictureInternal.hs +91/−41
• src/Wumpus/Core/VersionNumber.hs +2/−2
• src/Wumpus/Core/WumpusTypes.hs +9/−6
• wumpus-core.cabal +30/−1

@@ -20,8 +20,8 @@ rot30 :: (Rotate t, Fractional u, u ~ DUnit t) => t -> t
 rot30 = rotate30
 
-rot30P :: (Real u, Floating u) => Primitive u -> Primitive u
-rot30P = rotatePrimitive (d2r (30.0::Double))
+rot30P :: (Real u, Floating u) => PrimElement u -> PrimElement u
+rot30P = rotatePrim (d2r (30.0::Double))
 
 -- Primitive - Text
 

@@ -20,8 +20,8 @@ scale_onehalf_x_two = scale 1.5 2.0
 
 
-scale_onehalf_x_twoP :: Fractional u => Primitive u -> Primitive u
-scale_onehalf_x_twoP = scalePrimitive 1.5 2.0
+scale_onehalf_x_twoP :: Fractional u => PrimElement u -> PrimElement u
+scale_onehalf_x_twoP = scalePrim 1.5 2.0
 
 -- Primitive - Text
 

@@ -19,8 +19,8 @@ translate_20x40 :: (Translate t, Fractional u, u ~ DUnit t) => t -> t
 translate_20x40 = translate 20.0 40.0
 
-translate_20x40P :: Fractional u => Primitive u -> Primitive u
-translate_20x40P = translatePrimitive 20.0 40.0
+translate_20x40P :: Fractional u => PrimElement u -> PrimElement u
+translate_20x40P = translatePrim 20.0 40.0
 
 -- Primitive - Text
 

@@ -39,9 +39,9 @@       { ata_console_msg         :: String
       , ata_eps_file            :: FilePath
       , ata_svg_file            :: FilePath
-      , ata_prim_constructor    :: RGBi -> DPrimitive
+      , ata_prim_constructor    :: RGBi -> DPrimElement
       , ata_pic_transformer     :: DPicture -> DPicture
-      , ata_prim_transformer    :: DPrimitive -> DPrimitive
+      , ata_prim_transformer    :: DPrimElement -> DPrimElement
       }
 
 runATA :: AffineTrafoAlg -> IO ()
@@ -56,9 +56,9 @@                           (ata_prim_transformer ata)
 
 
-buildPictureATA :: (RGBi -> DPrimitive) 
+buildPictureATA :: (RGBi -> DPrimElement) 
          -> (DPicture -> DPicture) 
-         -> (DPrimitive -> DPrimitive) 
+         -> (DPrimElement -> DPrimElement) 
          -> DPicture
 buildPictureATA mk picF primF = 
     picture1 `picBeside` picture2 `picBeside` picture3
@@ -72,7 +72,7 @@     picture3 :: DPicture
     picture3 = illustrateBoundsPrim light_blue $ prim
       where
-        prim :: DPrimitive
+        prim :: DPrimElement
         prim = primF $ mk red
 
 
@@ -85,8 +85,8 @@       { cpa_console_msg         :: String
       , cpa_eps_file            :: FilePath
       , cpa_svg_file            :: FilePath
-      , cpa_prim_constructor    :: RGBi -> DPrimitive
-      , cpa_prim_transformer    :: DPrimitive -> DPrimitive 
+      , cpa_prim_constructor    :: RGBi -> DPrimElement
+      , cpa_prim_transformer    :: DPrimElement -> DPrimElement
       }
 
 runCPA :: ControlPointAlg -> IO ()
@@ -98,27 +98,27 @@   where
     pic = cpPicture (cpa_prim_constructor cpa) (cpa_prim_transformer cpa)
 
-cpPicture :: (RGBi -> DPrimitive) -> (DPrimitive -> DPrimitive) -> DPicture
+cpPicture :: (RGBi -> DPrimElement) -> (DPrimElement -> DPrimElement) -> DPicture
 cpPicture constr trafo = 
     illustrateBounds light_blue $ illustrateControlPoints black 
                                 $ transformed_prim
   where
-   transformed_prim :: DPrimitive
+   transformed_prim :: DPrimElement
    transformed_prim = trafo $ constr red
 
 
 --------------------------------------------------------------------------------
 
-rgbLabel :: RGBi -> DPrimitive
+rgbLabel :: RGBi -> DPrimElement
 rgbLabel rgb = textlabel rgb wumpus_default_font "Wumpus!" zeroPt
 
-rgbCircle :: RGBi -> DPrimitive
+rgbCircle :: RGBi -> DPrimElement
 rgbCircle rgb = fillEllipse rgb 60 60 zeroPt
 
-rgbEllipse :: RGBi -> DPrimitive
+rgbEllipse :: RGBi -> DPrimElement
 rgbEllipse rgb = fillEllipse rgb 60 30 zeroPt
 
-rgbPath :: RGBi -> DPrimitive
+rgbPath :: RGBi -> DPrimElement
 rgbPath rgb = ostroke rgb default_stroke_attr $ dog_kennel
 --------------------------------------------------------------------------------
 -- Demo - draw a dog kennel...

@@ -41,10 +41,10 @@ -- Note - each label is fully attributed with the font style. -- There really is not attribute inheritance. ---helveticaLabel :: Int -> String -> DPoint2 -> DPrimitive+helveticaLabel :: Int -> String -> DPoint2 -> DPrimElement helveticaLabel sz ss pt = textlabel peru attrs ss pt   where     attrs = FontAttr sz common_ff -courierLabel :: String -> DPoint2 -> DPrimitive+courierLabel :: String -> DPoint2 -> DPrimElement courierLabel ss pt = textlabel black wumpus_default_font ss pt

@@ -51,7 +51,7 @@   where     chars = (map letter "ABXabdgjxy12") ++ [agraveU] -type PrimF = DPoint2 -> DPrimitive+type PrimF = DPoint2 -> DPrimElement  bodyHeight  :: PrimF bodyHeight  = vertLine peru $ fromPtSize courier48_numeral_height@@ -59,15 +59,15 @@ agraveU     :: PrimF agraveU     = textlabel black courier_attr "&#Agrave" -letter :: Char -> DPoint2 -> DPrimitive+letter :: Char -> DPoint2 -> DPrimElement letter ch pt = textlabel black courier_attr [ch] pt  -vertLine :: RGBi -> Double -> DPoint2 -> DPrimitive+vertLine :: RGBi -> Double -> DPoint2 -> DPrimElement vertLine rgb height pt =      ostroke rgb default_stroke_attr $ vertexPath [pt, pt .+^ vvec height] -haxis :: RGBi -> PtSize -> DPrimitive+haxis :: RGBi -> PtSize -> DPrimElement haxis rgb ypos =      ostroke rgb dash_attr $ vertexPath [ pt, pt .+^ hvec 440 ]   where

@@ -39,10 +39,10 @@           , kernchar 6 'e'           ] -helveticaLabelH :: [KerningChar Double] -> DPoint2 -> DPrimitive+helveticaLabelH :: [KerningChar Double] -> DPoint2 -> DPrimElement helveticaLabelH xs pt = hkernlabel black helvetica18 xs pt -helveticaLabelV :: [KerningChar Double] -> DPoint2 -> DPrimitive+helveticaLabelV :: [KerningChar Double] -> DPoint2 -> DPrimElement helveticaLabelV xs pt = vkernlabel black helvetica18 xs pt  

@@ -27,7 +27,7 @@   -helveticaLabel :: String -> DPoint2 -> DPrimitive+helveticaLabel :: String -> DPoint2 -> DPrimElement helveticaLabel ss pt = textlabel black helvetica18 ss pt  helvetica18 :: FontAttr

@@ -26,7 +26,7 @@     ]  -square :: (Num u, Ord u) => RGBi -> u -> Point2 u -> Primitive u+square :: (Num u, Ord u) => RGBi -> u -> Point2 u -> PrimElement u square rgb sidelen bl = fill rgb $ vertexPath $     [bl, bl .+^ hvec sidelen, bl .+^ V2 sidelen sidelen, bl .+^ vvec sidelen] 

@@ -29,7 +29,7 @@  pic1 :: DPicture pic1 = illustrateBounds grey $ frame $ -    [ rotatePrimitive deg45 $ square blue 50 (P2 100 100)+    [ rotatePrim deg45 $ square blue 50 (P2 100 100)     , square red 50 (P2 100 100)     ] @@ -38,7 +38,7 @@ -- both ellipses should share the same center pic2 :: DPicture pic2 = illustrateBounds grey $ frame $ -    [ rotatePrimitive deg45 $ ellipseHH blue 25 (P2 100 100)+    [ rotatePrim deg45 $ ellipseHH blue 25 (P2 100 100)     , ellipseHH red 25 (P2 100 100)     ] @@ -46,21 +46,21 @@ -- both labels should share the same bottom left corner pic3 :: DPicture pic3 = illustrateBounds grey $ frame $ -    [ rotatePrimitive deg45 $  label blue (P2 100 100)+    [ rotatePrim deg45 $  label blue (P2 100 100)     , label red (P2 100 100)     ]  -square :: (Num u, Ord u) => RGBi -> u -> Point2 u -> Primitive u+square :: (Num u, Ord u) => RGBi -> u -> Point2 u -> PrimElement u square rgb sidelen bl = fill rgb $ vertexPath $     [bl, bl .+^ hvec sidelen, bl .+^ V2 sidelen sidelen, bl .+^ vvec sidelen]   -ellipseHH :: Fractional u => RGBi -> u -> Point2 u -> Primitive u+ellipseHH :: Fractional u => RGBi -> u -> Point2 u -> PrimElement u ellipseHH rgb radius ctr = fillEllipse rgb radius (0.5*radius) ctr  -label :: Num u => RGBi -> Point2 u -> Primitive u+label :: Num u => RGBi -> Point2 u -> PrimElement u label rgb bl = textlabel rgb wumpus_default_font "Wumpus" bl  

@@ -24,7 +24,7 @@  pic1 :: DPicture pic1 = illustrateBounds grey $ frame $ -    [ uniformScalePrimitive 0.5 $ square blue 50 (P2 100 100)+    [ uniformScalePrim 0.5 $ square blue 50 (P2 100 100)     , square red 50 (P2 100 100)     ] @@ -32,7 +32,7 @@ -- both ellipses should share the same center pic2 :: DPicture pic2 = illustrateBounds grey $ frame $ -    [ uniformScalePrimitive 0.5 $ ellipseHH blue 25 (P2 100 100)+    [ uniformScalePrim 0.5 $ ellipseHH blue 25 (P2 100 100)     , ellipseHH red 25 (P2 100 100)     ] @@ -40,20 +40,20 @@ -- both labels should share the same bottom left corner pic3 :: DPicture pic3 = illustrateBounds grey $ frame $-    [ uniformScalePrimitive 0.5 $ label blue (P2 100 100)+    [ uniformScalePrim 0.5 $ label blue (P2 100 100)     , label red (P2 100 100)     ]   -square :: (Num u, Ord u) => RGBi -> u -> Point2 u -> Primitive u+square :: (Num u, Ord u) => RGBi -> u -> Point2 u -> PrimElement u square rgb sidelen bl = fill rgb $ vertexPath $     [bl, bl .+^ hvec sidelen, bl .+^ V2 sidelen sidelen, bl .+^ vvec sidelen] -ellipseHH :: Fractional u => RGBi -> u -> Point2 u -> Primitive u+ellipseHH :: Fractional u => RGBi -> u -> Point2 u -> PrimElement u ellipseHH rgb radius ctr = fillEllipse rgb radius (0.5*radius) ctr  -label :: Num u => RGBi -> Point2 u -> Primitive u+label :: Num u => RGBi -> Point2 u -> PrimElement u label rgb bl = textlabel rgb wumpus_default_font "Wumpus" bl  

@@ -23,32 +23,32 @@ -- both squares should share the bottom left coord... pic1 :: DPicture pic1 = illustrateBounds grey $ frame $ -    [ translatePrimitive 100 10 $ square blue 50 (P2 100 100)+    [ translatePrim 100 10 $ square blue 50 (P2 100 100)     , square red 50 (P2 100 100)     ]  pic2 :: DPicture pic2 = illustrateBounds grey $ frame $ -    [ translatePrimitive 100 10 $ ellipseHH blue 25 (P2 100 100)+    [ translatePrim 100 10 $ ellipseHH blue 25 (P2 100 100)     , ellipseHH red 25 (P2 100 100)     ]  pic3 :: DPicture pic3 = illustrateBounds grey $ frame $ -    [ translatePrimitive 100 10 $ label blue (P2 100 100)+    [ translatePrim 100 10 $ label blue (P2 100 100)     , label red (P2 100 100)     ]   -square :: (Num u, Ord u) => RGBi -> u -> Point2 u -> Primitive u+square :: (Num u, Ord u) => RGBi -> u -> Point2 u -> PrimElement u square rgb sidelen bl = fill rgb $ vertexPath $     [bl, bl .+^ hvec sidelen, bl .+^ V2 sidelen sidelen, bl .+^ vvec sidelen] -ellipseHH :: Fractional u => RGBi -> u -> Point2 u -> Primitive u+ellipseHH :: Fractional u => RGBi -> u -> Point2 u -> PrimElement u ellipseHH rgb radius ctr = fillEllipse rgb radius (0.5*radius) ctr  -label :: Num u => RGBi -> Point2 u -> Primitive u+label :: Num u => RGBi -> Point2 u -> PrimElement u label rgb bl = textlabel rgb wumpus_default_font "Wumpus" bl  

@@ -27,7 +27,7 @@   -prim_list :: DPoint2 -> [DPrimitive]+prim_list :: DPoint2 -> [DPrimElement] prim_list = sequence [ fillEllipse red   20 20                      , \p -> fillEllipse green 20 20 (p .+^ hvec 20)                      , \p -> fillEllipse blue  20 20 (p .+^ hvec 40)

@@ -26,12 +26,12 @@   -makeLabelPrim :: String -> DPoint2 -> DPrimitive+makeLabelPrim :: String -> DPoint2 -> DPrimElement makeLabelPrim = textlabel black attrs    where     attrs     = FontAttr 10 (FontFace "Helvetica" "Helvetica" SVG_REGULAR) -makeLinePrim :: Double -> DPoint2 -> DPoint2 -> DPrimitive+makeLinePrim :: Double -> DPoint2 -> DPoint2 -> DPrimElement makeLinePrim lw a b = ostroke black attrs $ path a [lineTo b]   where     attrs = default_stroke_attr {line_width=lw}

@@ -73,7 +73,7 @@ import Wumpus.Core.AffineTrans import Wumpus.Core.BoundingBox import Wumpus.Core.Colour hiding ( black, white, red, green, blue )-import Wumpus.Core.FontSize+import Wumpus.Core.FontSize hiding ( textBoundsEnc ) import Wumpus.Core.Geometry import Wumpus.Core.GraphicsState hiding ( GraphicsState ) import Wumpus.Core.OutputPostScript

@@ -32,6 +32,9 @@   , red   , green   , blue+  , yellow+  , cyan+  , magenta        ) where @@ -69,25 +72,40 @@  -- | Black - 0, 0, 0. ---black :: RGBi-black = RGBi 0 0 0+black           :: RGBi+black           = RGBi 0 0 0  -- | White - 255, 255, 255. ---white :: RGBi-white = RGBi 255 255 255+white           :: RGBi+white           = RGBi 255 255 255  -- | Red - 255, 0, 0. ---red :: RGBi-red = RGBi 255 0 0+red             :: RGBi+red             = RGBi 255 0 0  -- | Green - 0, 255, 0. ---green :: RGBi -green = RGBi 0 255 0+green           :: RGBi +green           = RGBi 0 255 0  -- | Blue - 0, 0, 255. ---blue :: RGBi-blue = RGBi 0 0 255+blue            :: RGBi+blue            = RGBi 0 0 255++-- | Yellow - 255, 255, 0.+--+yellow          :: RGBi+yellow          = RGBi 255 255 0++-- | Cyan - 0, 255, 255.+--+cyan            :: RGBi+cyan            = RGBi 0 255 255++-- | Magenta - 255, 0, 255.+--+magenta         :: RGBi+magenta         = RGBi 255 0 255

@@ -51,12 +51,15 @@   , xcharHeight   , descenderDepth   , textBounds+  , textBoundsEnc       -- hidden by toplevel Wumpus.Core+  , charCount    ) where  import Wumpus.Core.BoundingBox import Wumpus.Core.Geometry import Wumpus.Core.PtSize+import Wumpus.Core.TextInternal  import Data.AffineSpace                 -- package: vector-space @@ -210,11 +213,53 @@ -- usually be too long. -- textBounds :: (Num u, Ord u, FromPtSize u) -           => FontSize -> Point2 u -> CharCount -> BoundingBox u-textBounds sz body_bl n = bbox bl tr where+           => FontSize -> Point2 u -> String -> BoundingBox u+textBounds sz pt ss = textBoundsBody sz pt (charCount ss) +++-- | Version of textBounds for EncodedText.+-- +-- Note this function is hidded by the top-level module +-- @Wumpus.Core@.+--+textBoundsEnc :: (Num u, Ord u, FromPtSize u) +           => FontSize -> Point2 u -> EncodedText -> BoundingBox u+textBoundsEnc sz pt enc = textBoundsBody sz pt (textLength enc) +++textBoundsBody :: (Num u, Ord u, FromPtSize u) +               => FontSize -> Point2 u -> Int -> BoundingBox u+textBoundsBody sz body_bl len = bbox bl tr +  where     h           = fromPtSize $ textHeight sz-    w           = fromPtSize $ textWidth  sz n+    w           = fromPtSize $ textWidth  sz len     dd          = fromPtSize $ descenderDepth sz     bl          = body_bl .-^ V2 0 dd      tr          = bl .+^ V2 w h-  +++++-- | Count the charcters in the supplied string.+--+-- Note escapes count as one character - for instance the length +-- of this string:+--+-- > abcd&#egrave;f+--+-- ... is 6.+-- +charCount :: String -> CharCount+charCount = outstep 0 +  where+    outstep n ('&':'#':xs)  = instep n xs+    outstep n (_:xs)        = outstep (n+1) xs+    outstep n []            = n+    +    instep  n (';':xs)      = outstep (n+1) xs+    instep  n (_:xs)        = instep  n xs+    instep  n []            = n                ++-- Note - the last case of instep indicates a malformed string, +-- but there is nothing that can be done. Promoting to Maybe or +-- Either would complicated the interface.

@@ -255,7 +255,7 @@ -- constructor. -- picture :: (Real u, Floating u, PSUnit u) => Picture u -> PsMonad Doc-picture (Leaf    (_,xs) ones)   = bracketTrafos xs $ revConcat primitive ones+picture (Leaf    (_,xs) ones)   = bracketTrafos xs $ revConcat primElement ones picture (Picture (_,xs) ones)   = bracketTrafos xs $ revConcat picture ones picture (Clip    (_,xs) cp pic) = bracketTrafos xs $                                     (vconcat <$> clipPath cp <*> picture pic)@@ -270,10 +270,16 @@     conc d (Some ac) = Some $ ac `vconcat` d  +-- No action is taken for hyperlinks in PostScript.+--+primElement :: (Real u, Floating u, PSUnit u) => PrimElement u -> PsMonad Doc+primElement (Atom prim)         = primitive prim+primElement (XLinkGroup _ ones) = revConcat primElement ones+ primitive :: (Real u, Floating u, PSUnit u) => Primitive u -> PsMonad Doc-primitive (PPath props _ pp)     = primPath props pp-primitive (PLabel props _ lbl)   = primLabel props lbl-primitive (PEllipse props _ ell) = primEllipse props ell+primitive (PPath props pp)     = primPath props pp+primitive (PLabel props lbl)   = primLabel props lbl+primitive (PEllipse props ell) = primEllipse props ell   primPath :: PSUnit u

@@ -169,7 +169,7 @@   picture :: (Real u, Floating u, PSUnit u) => Picture u -> SvgMonad Doc-picture (Leaf    (_,xs) ones)   = bracketTrafos xs $ revConcat primitive ones+picture (Leaf    (_,xs) ones)   = bracketTrafos xs $ revConcat primElement ones picture (Picture (_,xs) ones)   = bracketTrafos xs $ revConcat picture ones picture (Clip    (_,xs) cp pic) =      bracketTrafos xs $ do { lbl <- newClipLabel@@ -192,16 +192,18 @@     conc d (Some ac) = Some $ ac `vconcat` d  +primElement :: (Real u, Floating u, PSUnit u) => PrimElement u -> SvgMonad Doc+primElement (Atom prim)          = primitive prim+primElement (XLinkGroup xl ones) = drawXLink xl <$> revConcat primElement ones  primitive :: (Real u, Floating u, PSUnit u) => Primitive u -> SvgMonad Doc-primitive (PPath props xl pp)     = drawXLink xl <$> primPath props pp-primitive (PLabel props xl lbl)   = drawXLink xl <$> primLabel props lbl-primitive (PEllipse props xl ell) = drawXLink xl <$> primEllipse props ell+primitive (PPath props pp)     = primPath props pp+primitive (PLabel props lbl)   = primLabel props lbl+primitive (PEllipse props ell) = primEllipse props ell    drawXLink :: XLink -> Doc -> Doc-drawXLink NoLink           doc = doc-drawXLink (XLinkHRef href) doc = elem_a_xlink href doc+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

@@ -39,15 +39,19 @@ trivialTranslation pic = scale 1 (-1) (trivPic pic)  trivPic :: Num u => Picture u -> Picture u-trivPic (Leaf lc ones)      = Leaf lc $ fmap trivPrim ones+trivPic (Leaf lc ones)      = Leaf lc $ fmap trivPrimElt ones trivPic (Picture lc ones)   = Picture lc $ fmap trivPic ones trivPic (Clip lc pp pic)    = Clip lc pp $ trivPic pic trivPic (Group lc upd pic)  = Group lc upd $ trivPic pic +trivPrimElt :: Num u => PrimElement u -> PrimElement u+trivPrimElt (Atom prim)          = Atom (trivPrim prim)+trivPrimElt (XLinkGroup xl ones) = XLinkGroup xl $ fmap trivPrimElt ones+ trivPrim :: Num u => Primitive u -> Primitive u-trivPrim (PPath a xl pp)     = PPath a xl pp-trivPrim (PLabel a xl lbl)   = PLabel a xl (trivLabel lbl)-trivPrim (PEllipse a xl ell) = PEllipse a xl (trivEllipse ell)+trivPrim (PPath a pp)     = PPath a pp+trivPrim (PLabel a lbl)   = PLabel a (trivLabel lbl)+trivPrim (PEllipse a ell) = PEllipse a (trivEllipse ell)   trivLabel :: Num u => PrimLabel u -> PrimLabel u

@@ -30,42 +30,35 @@   , vertexPath   , curvedPath   , xlinkhref+  , xlinkGroup +   -- * Constructing primitives   , ostroke   , cstroke-  , xostroke-  , xcstroke   , zostroke   , zcstroke    , fill-  , xfill   , zfill -  , bordered-  , xbordered+  , fillStroke   , clip    , textlabel-  , xtextlabel   , ztextlabel   , wumpus_default_font    , hkernlabel   , vkernlabel-  , xhkernlabel-  , xvkernlabel   , kernchar   , kernEscInt   , kernEscName    , strokeEllipse   , fillEllipse-  , xstrokeEllipse-  , xfillEllipse   , zellipse-  , borderedEllipse+  , fillStrokeEllipse       -- * Operations@@ -113,7 +106,7 @@ -- -- This function throws an error when supplied the empty list. ---frame :: (Real u, Floating u, FromPtSize u) => [Primitive u] -> Picture u+frame :: (Real u, Floating u, FromPtSize u) => [PrimElement u] -> Picture u frame []     = error "Wumpus.Core.Picture.frame - empty list" frame (p:ps) = let (bb,ones) = step p ps in Leaf (bb,[]) ones    where@@ -209,9 +202,17 @@ -- | Create a hyperlink for SVG output. -- xlinkhref :: String -> XLink-xlinkhref = XLinkHRef+xlinkhref = XLink  +-- | Create a hyperlinked group of Primitives.+--+xlinkGroup :: XLink -> [PrimElement u] -> PrimElement u+xlinkGroup _     [] = error "Picture.xlinkGroup - empty prims list"+xlinkGroup xlink (x:xs) = XLinkGroup xlink (step x xs)+  where+    step a []     = one a+    step a (y:ys) = cons a (step y ys)   -------------------------------------------------------------------------------- -- Take Paths to Primitives@@ -221,46 +222,27 @@ -- | Create a open, stroked path. -- ostroke :: Num u -        => RGBi -> StrokeAttr -> PrimPath u -> Primitive u-ostroke rgb sa p = PPath (OStroke sa rgb) NoLink p+        => RGBi -> StrokeAttr -> PrimPath u -> PrimElement u+ostroke rgb sa p = Atom $ PPath (OStroke sa rgb) p   -- | Create a closed, stroked path. -- cstroke :: Num u -        => RGBi -> StrokeAttr -> PrimPath u -> Primitive u-cstroke rgb sa p = PPath (CStroke sa rgb) NoLink p---- | Create a open, stroked path with a hyperlink.------ Note - hyperlinks are only rendered in SVG output.----xostroke :: Num u -         => RGBi -> StrokeAttr -> XLink -> PrimPath u -> Primitive u-xostroke rgb sa xlink p = PPath (OStroke sa rgb) xlink p----- | Create a closed, stroked path with a hyperlink.------  Note - hyperlinks are only rendered in SVG output.----xcstroke :: Num u -         => RGBi -> StrokeAttr -> XLink -> PrimPath u -> Primitive u-xcstroke rgb sa xlink p = PPath (CStroke sa rgb) xlink p--+        => RGBi -> StrokeAttr -> PrimPath u -> PrimElement u+cstroke rgb sa p = Atom $ PPath (CStroke sa rgb) p   -- | Create an open, stroked path using the default stroke  -- attributes and coloured black. ---zostroke :: Num u => PrimPath u -> Primitive u+zostroke :: Num u => PrimPath u -> PrimElement u zostroke = ostroke black default_stroke_attr   -- | Create a closed stroked path using the default stroke  -- attributes and coloured black. ---zcstroke :: Num u => PrimPath u -> Primitive u+zcstroke :: Num u => PrimPath u -> PrimElement u zcstroke = cstroke black default_stroke_attr  --------------------------------------------------------------------------------@@ -269,24 +251,16 @@  -- | Create a filled path. ---fill :: Num u => RGBi -> PrimPath u -> Primitive u-fill rgb p = PPath (CFill rgb) NoLink p----- | Create a filled path with a hyperlink.------  Note - hyperlinks are only rendered in SVG output.----xfill :: Num u => RGBi -> XLink -> PrimPath u -> Primitive u-xfill rgb xlink p = PPath (CFill rgb) xlink p+fill :: Num u => RGBi -> PrimPath u -> PrimElement u+fill rgb p = Atom $ PPath (CFill rgb) p  -- | Create a filled path coloured black. -zfill :: Num u => PrimPath u -> Primitive u+zfill :: Num u => PrimPath u -> PrimElement u zfill = fill black   ----------------------------------------------------------------------------------- Bordered (closed) paths+-- Filled and stroked (closed) paths   -- | Create a closed path that is both filled and stroked (the fill@@ -294,21 +268,13 @@ -- -- > fill colour * stroke attrs * stroke_colour * ... ---bordered :: Num u -        => RGBi -> StrokeAttr -> RGBi -> PrimPath u -> Primitive u-bordered frgb sa srgb p = PPath (CFillStroke frgb sa srgb) NoLink p+fillStroke :: Num u +        => RGBi -> StrokeAttr -> RGBi -> PrimPath u -> PrimElement u+fillStroke frgb sa srgb p = Atom $ PPath (CFillStroke frgb sa srgb) p  --- | Create a bordered, closed path with a hyperlink.------  Note - hyperlinks are only rendered in SVG output.----xbordered :: Num u -        => RGBi -> StrokeAttr -> RGBi -> XLink -> PrimPath u -> Primitive u-xbordered frgb sa srgb xlink p = PPath (CFillStroke frgb sa srgb) xlink p  - -------------------------------------------------------------------------------- -- Clipping  @@ -326,20 +292,8 @@ -- The supplied point is the left baseline. -- textlabel :: Num u -          => RGBi -> FontAttr -> String -> Point2 u -> Primitive u-textlabel rgb attr txt = xtextlabel rgb attr NoLink txt ----- | Create a text label with a hyperlink. The string should not --- contain newline or tab characters.------ The supplied point is the left baseline.------ Note - hyperlinks are only rendered in SVG output.----xtextlabel :: Num u -           => RGBi -> FontAttr -> XLink -> String -> Point2 u -> Primitive u-xtextlabel rgb attr xlink txt pt = PLabel (LabelProps rgb attr) xlink lbl +           => RGBi -> FontAttr -> String -> Point2 u -> PrimElement u+textlabel rgb attr txt pt = Atom $ PLabel (LabelProps rgb attr) lbl    where     lbl = PrimLabel pt (StdLayout $ lexLabel txt) identityCTM @@ -347,8 +301,8 @@ -- | Create a label where the font is @Courier@, text size is 14pt -- and colour is black. ---ztextlabel :: Num u => String -> Point2 u -> Primitive u-ztextlabel = xtextlabel black wumpus_default_font NoLink+ztextlabel :: Num u => String -> Point2 u -> PrimElement u+ztextlabel = textlabel black wumpus_default_font   -- | Constant for the default font, which is @Courier@ (aliased @@ -384,21 +338,8 @@ -- hkernlabel :: Num u              => RGBi -> FontAttr -> [KerningChar u] -> Point2 u -            -> Primitive u-hkernlabel rgb attr xs = xhkernlabel rgb attr NoLink xs --- --- | Create a horizontally kerned text label with a hyperlink.------ The is the hyperlink version of 'hkernlabel'.------ Note - hyperlinks are only rendered in SVG output.----xhkernlabel :: Num u -            => RGBi -> FontAttr -> XLink -> [KerningChar u] -> Point2 u -            -> Primitive u-xhkernlabel rgb attr xlink xs pt = PLabel (LabelProps rgb attr) xlink lbl +            -> PrimElement u+hkernlabel rgb attr xs pt = Atom $ PLabel (LabelProps rgb attr) lbl    where     lbl = PrimLabel pt (KernTextH xs) identityCTM @@ -425,21 +366,9 @@ -- The supplied point is the left baseline of the top character. -- vkernlabel :: Num u -            => RGBi -> FontAttr ->[KerningChar u] -> Point2 u -            -> Primitive u-vkernlabel rgb attr xs = xvkernlabel rgb attr NoLink xs ----- | Create a vertically drawn text label with a hyperlink.------ The is the hyperlink version of 'vkernlabel'.------ Note - hyperlinks are only rendered in SVG output.----xvkernlabel :: Num u -            => RGBi -> FontAttr -> XLink -> [KerningChar u] -> Point2 u -            -> Primitive u-xvkernlabel rgb attr xlink xs pt = PLabel (LabelProps rgb attr) xlink lbl +            => RGBi -> FontAttr -> [KerningChar u] -> Point2 u +            -> PrimElement u+vkernlabel rgb attr xs pt = Atom $ PLabel (LabelProps rgb attr) lbl    where     lbl = PrimLabel pt (KernTextV xs) identityCTM @@ -483,57 +412,30 @@ -- Avoid non-uniform scaling stroked ellipses! -- strokeEllipse :: Num u -             => RGBi -> StrokeAttr -> u -> u -> Point2 u -> Primitive u-strokeEllipse rgb sa = xstrokeEllipse rgb sa NoLink-+             => RGBi -> StrokeAttr -> u -> u -> Point2 u -> PrimElement u+strokeEllipse rgb sa hw hh pt = +    Atom $ PEllipse (EStroke sa rgb) (PrimEllipse pt hw hh identityCTM)  -- | Create a filled ellipse. -- fillEllipse :: Num u -             => RGBi -> u -> u -> Point2 u -> Primitive u-fillEllipse rgb = xfillEllipse rgb NoLink---- | Create a stroked ellipse with a hyperlink.------ Note - hyperlinks are only rendered in SVG output.----xstrokeEllipse :: Num u -             => RGBi -> StrokeAttr -> XLink -> u -> u -> Point2 u -> Primitive u-xstrokeEllipse rgb sa xlink hw hh pt = -    PEllipse (EStroke sa rgb) xlink (PrimEllipse pt hw hh identityCTM)---- | Create a filled ellipse.------ Note - hyperlinks are only rendered in SVG output.--- -xfillEllipse :: Num u -             => RGBi -> XLink -> u -> u -> Point2 u -> Primitive u-xfillEllipse rgb xlink hw hh pt = -    PEllipse (EFill rgb) xlink (PrimEllipse pt hw hh identityCTM)+             => RGBi -> u -> u -> Point2 u -> PrimElement u+fillEllipse rgb hw hh pt = +    Atom $ PEllipse (EFill rgb) (PrimEllipse pt hw hh identityCTM)   -- | Create a black, filled ellipse. -zellipse :: Num u => u -> u -> Point2 u -> Primitive u-zellipse hw hh pt = xfillEllipse black NoLink hw hh pt+zellipse :: Num u => u -> u -> Point2 u -> PrimElement u+zellipse hw hh pt = fillEllipse black hw hh pt   -- | Create a bordered (i.e. filled and stroked) ellipse. ---borderedEllipse :: Num u -                => RGBi -> StrokeAttr -> RGBi -> u -> u -> Point2 u -                -> Primitive u-borderedEllipse frgb sa srgb = xborderedEllipse frgb sa srgb NoLink---- | Create a bordered (i.e. filled and stroked) ellipse with a --- hyperlink.------ Note - hyperlinks are only rendered in SVG output.----xborderedEllipse :: Num u -                 => RGBi -> StrokeAttr -> RGBi -> XLink -> u -> u -> Point2 u -                 -> Primitive u-xborderedEllipse frgb sa srgb xlink hw hh pt = -    PEllipse (EFillStroke frgb sa srgb) xlink (PrimEllipse pt hw hh identityCTM)+fillStrokeEllipse :: Num u +                 => RGBi -> StrokeAttr -> RGBi -> u -> u -> Point2 u +                 -> PrimElement u+fillStrokeEllipse frgb sa srgb hw hh pt = +    Atom $ PEllipse (EFillStroke frgb sa srgb) (PrimEllipse pt hw hh identityCTM)   @@ -617,7 +519,7 @@ -- The result will be lifted from Primitive to Picture. --  illustrateBoundsPrim :: (Real u, Floating u, FromPtSize u) -                     => RGBi -> Primitive u -> Picture u+                     => RGBi -> PrimElement u -> Picture u illustrateBoundsPrim rgb p = frame (p : boundsPrims rgb p)  @@ -626,7 +528,7 @@ -- joining the corners. -- boundsPrims :: (Num u, Ord u, Boundary t, u ~ DUnit t) -            => RGBi -> t -> [Primitive u]+            => RGBi -> t -> [PrimElement u] boundsPrims rgb a = [ bbox_rect, bl_to_tr, br_to_tl ]   where     (bl,br,tr,tl) = boundaryCorners $ boundary a@@ -638,24 +540,27 @@                                         , dash_pattern = Dash 0 [(1,2)] }  --- | Generate the control points illustrating the Bezier --- curves within a picture.+-- | Generate the control points illustrating the Bezier curves +-- within a picture. -- --- This has no effect on TextLabels.+-- This has no effect on TextLabels. Nor does it draw Beziers of +-- a hyperlinked obkect. -- --- Pseudo control points are generated for ellipses, --- although strictly speaking ellipses do not use Bezier--- curves - they are implemented with PostScript\'s --- @arc@ command.  +-- Pseudo control points are generated for ellipses, although +-- strictly speaking ellipses do not use Bezier curves - they +-- are implemented with PostScript\'s @arc@ command.   -- illustrateControlPoints :: (Real u, Floating u, FromPtSize u)-                        => RGBi -> Primitive u -> Picture u-illustrateControlPoints rgb prim = step prim+                        => RGBi -> PrimElement u -> Picture u+illustrateControlPoints rgb elt = outer elt   where-    step (PEllipse _ _ e) = frame (prim : ellipseCtrlLines rgb e)-    step (PPath    _ _ p) = frame (prim : pathCtrlLines rgb p)-    step _                = frame [prim]+    outer a@(Atom prim) = frame (a : step prim)+    outer a             = frame [a] +    step (PEllipse _ e) = ellipseCtrlLines rgb e+    step (PPath    _ p) = pathCtrlLines rgb p+    step _              = []+ -- Genrate lines illustrating the control points of curves on  -- a Path. --@@ -664,7 +569,7 @@ -- -- Nothing is generated for a straight line. ---pathCtrlLines :: (Num u, Ord u) => RGBi -> PrimPath u -> [Primitive u]+pathCtrlLines :: (Num u, Ord u) => RGBi -> PrimPath u -> [PrimElement u] pathCtrlLines rgb (PrimPath start ss) = step start ss   where      -- trail the current end point through the recursion...@@ -683,7 +588,7 @@ -- start-point to control-point1; control-point2 to end-point -- ellipseCtrlLines :: (Real u, Floating u) -                 => RGBi -> PrimEllipse u -> [Primitive u]+                 => RGBi -> PrimEllipse u -> [PrimElement u] ellipseCtrlLines rgb pe = start all_points   where      -- list in order: 

@@ -25,6 +25,8 @@   , AffineTrafo(..)   , FontCtx(..) +  , PrimElement(..)+  , DPrimElement   , Primitive(..)   , DPrimitive   , XLink(..)@@ -55,10 +57,10 @@   , matrixRepCTM   , translMatrixRepCTM -  , rotatePrimitive-  , scalePrimitive-  , uniformScalePrimitive-  , translatePrimitive+  , rotatePrim+  , scalePrim+  , uniformScalePrim+  , translatePrim    -- * Additional operations   , concatTrafos@@ -82,6 +84,7 @@   import Data.AffineSpace                         -- package: vector-space+import Data.Semigroup                           -- package: algebra  import qualified Data.Foldable                  as F @@ -125,13 +128,27 @@ -- updates for the SVG renderer - in some instances this can  -- improve the code size of the generated SVG. ---data Picture u = Leaf     (Locale u)              (OneList (Primitive u))+data Picture u = Leaf     (Locale u)              (OneList (PrimElement u))                | Picture  (Locale u)              (OneList (Picture u))                | Clip     (Locale u) (PrimPath u) (Picture u)                | Group    (Locale u) FontCtx      (Picture u)   deriving (Show) +type DPicture = Picture Double +-- | To represent XLink hyperlinks, Primitives in a Leaf are +-- 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).+--+data PrimElement u = Atom             (Primitive u)+                   | XLinkGroup XLink (OneList (PrimElement u))+  deriving (Show)++type DPrimElement = PrimElement Double++ -- | Set the font /delta/ for SVG rendering.  --  -- Note - this does not change the default colour or font style. @@ -161,7 +178,6 @@ -- type Locale u = (BoundingBox u, [AffineTrafo u]) -type DPicture = Picture Double  -- | Affine transformations are represented as /syntax/ so they -- can be manipulated easily.@@ -196,17 +212,16 @@ -- Though typically for affine transformations a Fractional  -- constraint is also obliged. ---data Primitive u = PPath    PathProps    XLink (PrimPath u)-                 | PLabel   LabelProps   XLink (PrimLabel u)-                 | PEllipse EllipseProps XLink (PrimEllipse u)+data Primitive u = PPath    PathProps    (PrimPath u)+                 | PLabel   LabelProps   (PrimLabel u)+                 | PEllipse EllipseProps (PrimEllipse u)   deriving (Eq,Show)  type DPrimitive = Primitive Double --- | Primitives can be annotated with hyperlinks in SVG output.+-- | Primitives can be grouped with hyperlinks in SVG output. ---data XLink = NoLink-           | XLinkHRef String+newtype XLink = XLink { getXLink :: String }   deriving (Eq,Show)  -- | PrimPath - start point and a list of path segments.@@ -323,6 +338,7 @@ -- family instances  type instance DUnit (Picture u)     = u+type instance DUnit (PrimElement u) = u type instance DUnit (Primitive u)   = u type instance DUnit (PrimEllipse u) = u @@ -333,7 +349,7 @@ instance (Num u, PSUnit u) => Format (Picture u) where   format (Leaf m prims)     = indent 2 $ vcat [ text "** Leaf-pic **"                                               , fmtLocale m -                                              , fmtPrims prims ]+                                              , fmtPrimElems prims ]    format (Picture m pics)   = indent 2 $ vcat [ text "** Tree-pic **"                                               , fmtLocale m@@ -354,23 +370,29 @@   where     fn (n,acc) e = (n+1, vcat [ acc, text "-- " <+> int n, format e, line]) -fmtPrims :: PSUnit u => OneList (Primitive u) -> Doc-fmtPrims ones = snd $ F.foldl' fn (0,empty) ones+fmtPrimElems :: PSUnit u => OneList (PrimElement u) -> Doc+fmtPrimElems ones = snd $ F.foldl' fn (0,empty) ones   where     fn (n,acc) e = (n+1, vcat [ acc, text "-- leaf" <+> int n, format e, line]) +instance PSUnit u => Format (PrimElement u) where+  format (Atom prim)          = format prim+  format (XLinkGroup xl ones) = vcat [ text "-- xlink " <+> format xl +                                     , fmtPrimElems ones  ]+                                     + fmtLocale :: (Num u, PSUnit u) => Locale u -> Doc fmtLocale (bb,_) = format bb   instance PSUnit u => Format (Primitive u) where-  format (PPath props _ p)    = +  format (PPath props p)    =        indent 2 $ vcat [ text "path:" <+> format props, format p ] -  format (PLabel props _ l)   =+  format (PLabel props l)   =       indent 2 $ vcat [ text "label:" <+> format props, format l ] -  format (PEllipse props _ e) = +  format (PEllipse props e) =        indent 2 $ vcat [ text "ellipse:" <+> format props, format e ]  @@ -431,6 +453,8 @@   format (EFillStroke f _ s)  = format f <+> text "Fill" <> char '/'                             <+> format s <+> text "Stroke"    +instance Format XLink where+  format (XLink ss) = text "xlink" <+> text ss   --------------------------------------------------------------------------------@@ -441,10 +465,21 @@   boundary (Clip    (bb,_) _ _) = bb   boundary (Group   (bb,_) _ _) = bb ++instance (Real u, Floating u, FromPtSize u) => Boundary (PrimElement u) where+  boundary (Atom prim)         = boundary prim+  boundary (XLinkGroup _ ones) = outer $ viewl ones +    where+      outer (OneL a)     = boundary a+      outer (a :< as)    = inner (boundary a) (viewl as)++      inner bb (OneL a)  = bb `append` boundary a+      inner bb (a :< as) = inner (bb `append` boundary a) (viewl as)+ instance (Real u, Floating u, FromPtSize u) => Boundary (Primitive u) where-  boundary (PPath _ _ p)      = pathBoundary p-  boundary (PLabel a _ l)     = labelBoundary (label_font a) l-  boundary (PEllipse _ _ e)   = ellipseBoundary e+  boundary (PPath _ p)      = pathBoundary p+  boundary (PLabel a l)     = labelBoundary (label_font a) l+  boundary (PEllipse _ e)   = ellipseBoundary e   @@ -480,14 +515,14 @@  labelBodyBoundary :: (Num u, Ord u, FromPtSize u)                    => FontSize -> LabelBody u -> BoundingBox u-labelBodyBoundary sz (StdLayout etxt) = stdLayoutBB sz (textLength etxt)+labelBodyBoundary sz (StdLayout etxt) = stdLayoutBB sz etxt labelBodyBoundary sz (KernTextH xs)   = hKerningBB sz xs labelBodyBoundary sz (KernTextV xs)   = vKerningBB sz xs   stdLayoutBB :: (Num u, Ord u, FromPtSize u) -            => FontSize -> CharCount -> BoundingBox u-stdLayoutBB sz len = textBounds sz zeroPt len+            => FontSize -> EncodedText -> BoundingBox u+stdLayoutBB sz etxt = textBoundsEnc sz zeroPt etxt  -- Note - this assumes positive deltas (and a nonempty list)... --@@ -499,7 +534,7 @@ --  hKerningBB :: (Num u, Ord u, FromPtSize u)             => FontSize -> [(u,EncodedChar)] -> BoundingBox u-hKerningBB sz xs = rightGrow (sumDiffs xs) $ textBounds sz zeroPt 1+hKerningBB sz xs = rightGrow (sumDiffs xs) $ textBounds sz zeroPt "A"   where     sumDiffs                          = foldr (\(u,_) i -> i+u)  0     rightGrow u (BBox ll (P2 x1 y1))  = BBox ll (P2 (x1+u) y1)@@ -516,7 +551,7 @@ -- vKerningBB :: (Num u, Ord u, FromPtSize u)             => FontSize -> [(u,EncodedChar)] -> BoundingBox u-vKerningBB sz xs = downGrow (sumDiffs xs) $ textBounds sz zeroPt 1+vKerningBB sz xs = downGrow (sumDiffs xs) $ textBounds sz zeroPt "A"   where     sumDiffs                                = foldr (\(u,_) i -> i+u)  0     downGrow u (BBox (P2 x0 y0) (P2 x1 y1)) = BBox (P2 x0 (y0-u)) (P2 x1 y1)@@ -627,11 +662,18 @@ -- generated PostScript. For Paths all transformations are -- \"cost-free\". --+rotatePrim :: (Real u, Floating u) +           => Radian -> PrimElement u -> PrimElement u+rotatePrim ang (Atom prim)             = Atom $ rotatePrimitive ang prim+rotatePrim ang (XLinkGroup xlink ones) = +    XLinkGroup xlink $ fmap (rotatePrim ang) ones++ rotatePrimitive :: (Real u, Floating u)                  => Radian -> Primitive u -> Primitive u-rotatePrimitive ang (PPath a xl path)   = PPath a xl $ rotatePath ang path-rotatePrimitive ang (PLabel a xl lbl)   = PLabel a xl $ rotateLabel ang lbl-rotatePrimitive ang (PEllipse a xl ell) = PEllipse a xl $ rotateEllipse ang ell+rotatePrimitive ang (PPath a path)   = PPath    a $ rotatePath ang path+rotatePrimitive ang (PLabel a lbl)   = PLabel   a $ rotateLabel ang lbl+rotatePrimitive ang (PEllipse a ell) = PEllipse a $ rotateEllipse ang ell   -- | Scale a Primitive.@@ -656,15 +698,21 @@ -- generated PostScript. For Paths all transformations are  -- \"cost-free\". --+scalePrim :: Num u => u -> u -> PrimElement u -> PrimElement u+scalePrim x y (Atom prim)             = Atom $ scalePrimitive x y prim+scalePrim x y (XLinkGroup xlink ones) = +    XLinkGroup xlink $ fmap (scalePrim x y) ones++ scalePrimitive :: Num u => u -> u -> Primitive u -> Primitive u-scalePrimitive x y (PPath a xl path)   = PPath    a xl $ scalePath x y path-scalePrimitive x y (PLabel a xl lbl)   = PLabel   a xl $ scaleLabel x y lbl-scalePrimitive x y (PEllipse a xl ell) = PEllipse a xl $ scaleEllipse x y ell+scalePrimitive x y (PPath a path)   = PPath    a $ scalePath x y path+scalePrimitive x y (PLabel a lbl)   = PLabel   a $ scaleLabel x y lbl+scalePrimitive x y (PEllipse a ell) = PEllipse a $ scaleEllipse x y ell  -- | Apply a uniform scale to a Primitive. ---uniformScalePrimitive :: Num u => u -> Primitive u -> Primitive u-uniformScalePrimitive d = scalePrimitive d d +uniformScalePrim :: Num u => u -> PrimElement u -> PrimElement u+uniformScalePrim d = scalePrim d d   -- | Translate a primitive. --@@ -676,15 +724,17 @@ -- translation will be concatenated into the matrix operation in  -- the generated output.  -- -translatePrimitive :: Num u => u -> u -> Primitive u -> Primitive u-translatePrimitive x y (PPath a xl path)   = -    PPath a xl $ translatePath x y path+translatePrim :: Num u => u -> u -> PrimElement u -> PrimElement u+translatePrim x y (Atom prim)             = +    Atom $ translatePrimitive x y prim -translatePrimitive x y (PLabel a xl lbl)   = -    PLabel a xl $ translateLabel x y lbl+translatePrim x y (XLinkGroup xlink ones) = +    XLinkGroup xlink $ fmap (translatePrim x y) ones -translatePrimitive x y (PEllipse a xl ell) = -    PEllipse a xl $ translateEllipse x y ell+translatePrimitive :: Num u => u -> u -> Primitive u -> Primitive u+translatePrimitive x y (PPath a path)   = PPath a $ translatePath x y path+translatePrimitive x y (PLabel a lbl)   = PLabel a $ translateLabel x y lbl+translatePrimitive x y (PEllipse a ell) = PEllipse a $ translateEllipse x y ell   

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

@@ -20,7 +20,8 @@ -- Having this module just re-exporting types should make  -- the Haddock documentation more cohesive. Modules -- in wumpus-core should not use this module.-+-- +-- Note - XLink only exports the NoLink constructors.  module Wumpus.Core.WumpusTypes   (@@ -28,6 +29,8 @@   -- * Picture types     Picture   , DPicture+  , PrimElement+  , DPrimElement   , FontCtx   , Primitive   , DPrimitive@@ -48,11 +51,11 @@   -  -- * Transformations on Primitives-  , rotatePrimitive-  , scalePrimitive-  , uniformScalePrimitive-  , translatePrimitive+  -- * Transformations on PrimElements+  , rotatePrim+  , scalePrim+  , uniformScalePrim+  , translatePrim     -- * Printable unit for PostScript

@@ -1,5 +1,5 @@ name:             wumpus-core-version:          0.31.0+version:          0.32.0 license:          BSD3 license-file:     LICENSE copyright:        Stephen Tetley <stephen.tetley@gmail.com>@@ -44,6 +44,35 @@   (bitmaps).    .   Changelog:+  .+  0.31.0 to 0.32.0:+  .+  * Major API changes to @Core.Picture@ for XML hyperlinks.+    Hyperlinks now group one-or-more Primitives (path or label), +    instead of being attached to a single Primitive. This better+    corresponds with XML but it has made the Picture type more +    complicated, and has mandated significant changes to the +    Picture API. All the hyperlink variants of the Primitive +    constructors have been removed (xcstroke, xfill, xtextlabel, +    ...), and hyperlinks are now created with @xlinkGroup@. +  .+  * The type signatures for the /primitive/ constructors (fill, +    cstroke, textlabel, ...) in the Picture API have changed and +    are now more complicated as there is an extra layer of +    indirection in the type hierarchy.+  .+  * The primitive constructors for filled and stroked paths and +    ellipses have been renamed: @bordered@ is now @fillStroke@,+    @borderedEllipse@ is now @fillStrokeEllipse@.+  .+  * @Core.FontSize@ - the arguments to the function @textBounds@+    have been changed to take the String in question, rather than +    its precomputed length. The size of the string is then +    calculated with the new function @charCount@ which takes into +    account escaped characters.+  .+  * Added @yellow@, @cyan@ and @magenta@ to the predefined +    colours in @Core.Colour@.   .   0.30.0 to 0.31.0:   .