packages feed

wumpus-core 0.51.0 → 0.52.0

raw patch · 15 files changed

+133/−42 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Wumpus.Core.Picture: clip :: PrimPath -> Primitive -> Primitive
+ Wumpus.Core.Geometry: orthoVec :: Floating u => u -> u -> Radian -> Vec2 u
+ Wumpus.Core.Geometry: vdiff :: Num u => Vec2 u -> Vec2 u -> Vec2 u
+ Wumpus.Core.Geometry: vsum :: Num u => [Vec2 u] -> Vec2 u
+ Wumpus.Core.Picture: clipPrim :: PrimPath -> Primitive -> Primitive
+ Wumpus.Core.Picture: xidPrim :: String -> Primitive -> Primitive
+ Wumpus.Core.WumpusTypes: data SvgAttr
- Wumpus.Core.Geometry: d2r :: (Floating a, Real a) => a -> Radian
+ Wumpus.Core.Geometry: d2r :: Double -> Radian
- Wumpus.Core.Geometry: r2d :: (Floating a, Real a) => Radian -> a
+ Wumpus.Core.Geometry: r2d :: Radian -> Double

Files

demo/ClipPic.hs view
@@ -20,7 +20,8 @@ pic1 :: Picture pic1 = frame [ body ]   where-    body = clip dog_house $ primGroup [ red_circle, green_circle, blue_circle ]+    body = clipPrim dog_house $ +             primGroup [ red_circle, green_circle, blue_circle ]  red_circle :: Primitive  red_circle = fillEllipse red 60 60      $ P2 (-20) 0
demo/EllipsePic.hs view
@@ -34,5 +34,5 @@  ellipse03 :: DPoint2 -> Primitive ellipse03 pt = cstroke red default_stroke_attr $ -    curvedPrimPath $ rbezierEllipse 20 30 (negate $ d2r (10::Double)) pt+    curvedPrimPath $ rbezierEllipse 20 30 (negate $ d2r 10) pt
demo/Hyperlink.hs view
@@ -11,8 +11,8 @@ main :: IO () main = do      createDirectoryIfMissing True "./out/"-    writeEPS "./out/svg_link01.eps"  link_pic-    writeSVG "./out/svg_link01.svg"  link_pic+    writeEPS "./out/hyperlink01.eps"  link_pic+    writeSVG "./out/hyperlink01.svg"  link_pic   link_pic :: Picture
demo/TransformEllipse.hs view
@@ -42,7 +42,7 @@      ell  = mkRedEllipse (rotate ang) 20 10 pt      cb   = rotate ang $ crossbar 20 10 pt      pt   = P2 70 10-     ang  = d2r (30::Double)+     ang  = d2r 30  pic3 :: Picture pic3 = cb `picOver` ell `picOver` xy_frame "rotateAbout (60,0) 30deg"@@ -51,7 +51,7 @@      cb   = rotateAbout ang pto $ crossbar 20 10 pt      pt   = P2 70 10      pto  = P2 60 0 `asTypeOf` dpt-     ang  = d2r (30::Double)+     ang  = d2r 30   pic4 :: Picture
demo/TransformPath.hs view
@@ -40,7 +40,7 @@      pth  = mkBlackPath (rotate ang) pt      ch   = rotate ang $ zcrosshair pt      pt   = P2 70 10-     ang  = d2r (30::Double)+     ang  = d2r 30   pic3 :: Picture@@ -50,7 +50,7 @@      ch   = rotateAbout ang pto $ zcrosshair pt      pt   = P2 70 10      pto  = P2 60 0 `asTypeOf` dpt-     ang  = d2r (30::Double)+     ang  = d2r 30       pic4 :: Picture
demo/TransformTextlabel.hs view
@@ -40,7 +40,7 @@     txt  = mkBlackTextlabel (rotate ang) pt     ch   = rotate ang $ zcrosshair pt     pt   = P2 70 10-    ang  = d2r (30::Double)+    ang  = d2r 30   pic3 :: Picture@@ -50,7 +50,7 @@     ch   = rotateAbout ang pto $ zcrosshair pt     pt   = P2 70 10     pto  = P2 60 0 `asTypeOf` dpt-    ang  = d2r (30::Double)+    ang  = d2r 30   pic4 :: Picture
src/Wumpus/Core/Geometry.hs view
@@ -60,10 +60,13 @@   , vvec   , avec   , pvec+  , orthoVec   , vreverse   , vdirection   , vlength   , vangle+  , vsum+  , vdiff    -- * Point operations   , zeroPt@@ -564,6 +567,15 @@ pvec = flip (.-.)  ++-- | Build a vector form its parallel and perpendicular components+-- and inclination.+--+orthoVec :: Floating u => u -> u -> Radian -> Vec2 u +orthoVec pall perp ang = avec ang pall ^+^ avec (ang + half_pi) perp+  where+    half_pi = 0.5 * pi+ -- | 'vreverse' : @ vec -> Vec2 @ -- -- Reverse a vector.@@ -598,6 +610,26 @@ vangle u v = realToFrac $ acos $ (u <.> v) / (magnitude u * magnitude v)  +-- | Sum a list of Vectors.+--+vsum :: Num u => [Vec2 u] -> Vec2 u+vsum [] = V2 0 0+vsum (v:vs) = go v vs+  where+    go a []     = a+    go a (b:bs) = go (a ^+^ b) bs+++-- | Find the /difference/ between two vectors - i.e. flipped+-- vector subtraction:+--+-- > vdiff = flip (^-^)+-- +vdiff :: Num u => Vec2 u -> Vec2 u -> Vec2 u+vdiff  = flip (^-^)+++ -------------------------------------------------------------------------------- -- Points @@ -849,12 +881,18 @@  -- | Degrees to radians. ---d2r :: (Floating a, Real a) => a -> Radian+-- Degree type fixed to @Double@, compose @d2r@ with @realToFrac@ +-- for @Float@ etc.+--+d2r :: Double -> Radian d2r = Radian . realToFrac . (*) (pi/180)  -- | Radians to degrees. ---r2d :: (Floating a, Real a) => Radian -> a+-- Degree type fixed to @Double@, compose @r2d@ with @realToFrac@ +-- for @Float@ etc.+--+r2d :: Radian -> Double r2d = (*) (180/pi) . fromRadian
src/Wumpus/Core/OutputPostScript.hs view
@@ -431,7 +431,7 @@ -- encoded in the matrix, hence the @ 0 0 moveto @. -- primLabel :: LabelProps -> PrimLabel -> PsMonad Doc-primLabel (LabelProps rgb attrs) (PrimLabel body ctm) = bracketPrimCTM ctm mf+primLabel (LabelProps rgb attrs) (PrimLabel body _ ctm) = bracketPrimCTM ctm mf   where     ev    = font_enc_vector $ font_face attrs         mf pt = (\rgbd fontd -> vcat [ rgbd, fontd, labelBody ev pt body ])
src/Wumpus/Core/OutputSVG.hs view
@@ -240,6 +240,7 @@ svgAnnoPrim (ALink hypl)    d = drawXLink hypl d svgAnnoPrim (GAnno xs)      d = drawGProps xs d svgAnnoPrim (SvgAG hypl xs) d = drawXLink hypl $ drawGProps xs d +svgAnnoPrim (SvgId ss)      d = drawGProps [SvgAttr "id" ss] d    drawXLink :: XLink -> Doc -> Doc@@ -346,13 +347,13 @@ --  primLabel :: LabelProps -> PrimLabel -> SvgMonad Doc-primLabel (LabelProps rgb attrs) (PrimLabel body ctm) = -    (\fa ca -> elem_text (fa <+> ca) (makeTspan rgb dtext))+primLabel (LabelProps rgb attrs) (PrimLabel body opt_id ctm) = +    (\fa ca -> elem_text (id_f $ fa <+> ca) (makeTspan rgb dtext))       <$> deltaFontAttrs attrs <*> bracketTextCTM ctm coordf-                                  where     coordf = \p0 -> pure $ labelBodyCoords body p0     dtext  = labelBodyText body+    id_f   = maybe id (\xid -> (svgAttr "id" (text xid) <+>)) $ opt_id  labelBodyCoords :: LabelBody -> DPoint2 -> Doc labelBodyCoords (StdLayout _)  pt = makeXY pt
src/Wumpus/Core/PageTranslation.hs view
@@ -66,8 +66,8 @@   trivLabel :: PrimLabel -> PrimLabel-trivLabel (PrimLabel txt ctm) = -    PrimLabel txt (trivPrimCTM ctm)+trivLabel (PrimLabel txt opt_id ctm) = +    PrimLabel txt opt_id (trivPrimCTM ctm)  trivEllipse :: PrimEllipse -> PrimEllipse trivEllipse (PrimEllipse hw hh ctm) = PrimEllipse hw hh (trivPrimCTM ctm)
src/Wumpus/Core/Picture.hs view
@@ -50,6 +50,7 @@   , curvedPrimPath   , xlinkhref   , xlinkPrim+  , xidPrim   , svgattr   , annotateGroup   , annotateXLink@@ -68,7 +69,7 @@   , zfill    , fillStroke-  , clip+  , clipPrim    , textlabel   , rtextlabel@@ -333,14 +334,28 @@ xlinkhref = XLink  --- | Create a hyperlinked Primitive.+-- | Hyperlinked Primitive. --+-- This encloses the Primitive in an addition @\<g\>@ element.+-- -- Note - hyperlinks are ignored in the PostScript output. -- xlinkPrim :: XLink -> Primitive -> Primitive xlinkPrim hypl p = PSVG (ALink hypl) p    +-- | Annotate a Primitive with an @id@. +-- +-- For text labels this annotates the label directly, for other+-- primitives the annotation adds extra nesting with a @\<g\>@ +-- element.+--+-- Note - ids are ignored in the PostScript output.+--+xidPrim :: String -> Primitive -> Primitive+xidPrim = pushXIdAnno++ -- | Create an attribute for SVG output. -- -- Attributes are expected to be /non-graphical/ e.g. @onclick@ @@ -488,12 +503,12 @@ -------------------------------------------------------------------------------- -- Clipping  --- | 'clip' : @ path * primitive -> Primitive @+-- | 'clipPrim' : @ path * primitive -> Primitive @ --  -- Clip a primitive to be inside the supplied path. ---clip :: PrimPath -> Primitive -> Primitive-clip cp p = PClip cp p+clipPrim :: PrimPath -> Primitive -> Primitive+clipPrim cp p = PClip cp p  -------------------------------------------------------------------------------- -- Labels to primitive@@ -557,7 +572,7 @@               -> Primitive rescapedlabel rgb attr txt theta (P2 dx dy) = PLabel (LabelProps rgb attr) lbl    where-    lbl = PrimLabel (StdLayout txt) (makeThetaCTM dx dy theta)+    lbl = PrimLabel (StdLayout txt) Nothing (makeThetaCTM dx dy theta)   -- | 'zescapedlabel' : @ escaped_text * baseline_left -> Primitive @@@ -605,7 +620,7 @@ hkernlabel :: RGBi -> FontAttr -> [KerningChar] -> DPoint2 -> Primitive hkernlabel rgb attr xs (P2 x y) = PLabel (LabelProps rgb attr) lbl    where-    lbl = PrimLabel (KernTextH xs) (makeTranslCTM x y)+    lbl = PrimLabel (KernTextH xs) Nothing (makeTranslCTM x y)   @@ -645,7 +660,7 @@ vkernlabel :: RGBi -> FontAttr -> [KerningChar] -> DPoint2 -> Primitive vkernlabel rgb attr xs (P2 x y) = PLabel (LabelProps rgb attr) lbl    where-    lbl = PrimLabel (KernTextV xs) (makeTranslCTM x y)+    lbl = PrimLabel (KernTextV xs) Nothing (makeTranslCTM x y)
src/Wumpus/Core/PictureInternal.hs view
@@ -51,6 +51,8 @@   , isEmptyPath   , isEmptyLabel +  , pushXIdAnno+   ) where  import Wumpus.Core.AffineTrans@@ -175,15 +177,18 @@  -- | SVG annotations - annotations can be:  -- --- A hyperlink inside @<a ...> ... </a>@ .+-- * A hyperlink inside @<a ...> ... </a>@ . ----- A group - @<g ...> ... </g>@+-- * A group - @<g ...> ... </g>@ ----- A group inside a hyperlink.+-- * A group of annotations inside a hyperlink. --+-- * An @id@.+-- data SvgAnno = ALink XLink              | GAnno [SvgAttr]              | SvgAG XLink [SvgAttr]+             | SvgId String    deriving (Eq,Show)  @@ -284,6 +289,7 @@ -- data PrimLabel = PrimLabel        { label_body      :: LabelBody+      , label_opt_id    :: Maybe String       , label_ctm       :: PrimCTM       }   deriving (Eq,Show)@@ -420,8 +426,9 @@   format (RelLineTo pt)         = text "rel_line_to  " <> format pt  instance Format PrimLabel where-  format (PrimLabel s ctm) = +  format (PrimLabel s opt_id ctm) =       vcat [ dquotes (format s)+          , maybe (char '_') text $ opt_id            , text "ctm="           <> format ctm           ] @@ -508,7 +515,7 @@   labelBoundary :: FontAttr -> PrimLabel -> BoundingBox Double-labelBoundary attr (PrimLabel body ctm) = +labelBoundary attr (PrimLabel body _ ctm) =      retraceBoundary (m33 *#) untraf_bbox   where     m33         = matrixRepCTM ctm@@ -720,26 +727,27 @@ -- label. -- rotateLabel :: Radian -> PrimLabel -> PrimLabel-rotateLabel ang (PrimLabel txt ctm) = PrimLabel txt (rotateCTM ang ctm)+rotateLabel ang (PrimLabel txt opt_id ctm) = +    PrimLabel txt opt_id (rotateCTM ang ctm)   -- /rotateAbout/ the start-point, /rotate/ the the CTM. -- rotateAboutLabel :: Radian -> DPoint2 -> PrimLabel -> PrimLabel-rotateAboutLabel ang (P2 x y) (PrimLabel txt ctm) = -    PrimLabel txt (rotateAboutCTM ang (P2 x y) ctm)+rotateAboutLabel ang (P2 x y) (PrimLabel txt opt_id ctm) = +    PrimLabel txt opt_id (rotateAboutCTM ang (P2 x y) ctm)   scaleLabel :: Double -> Double -> PrimLabel -> PrimLabel-scaleLabel sx sy (PrimLabel txt ctm) = -    PrimLabel txt (scaleCTM sx sy ctm)+scaleLabel sx sy (PrimLabel txt opt_id ctm) = +    PrimLabel txt opt_id (scaleCTM sx sy ctm)   -- Change the bottom-left corner. -- translateLabel :: Double -> Double -> PrimLabel -> PrimLabel-translateLabel dx dy (PrimLabel txt ctm) = -    PrimLabel txt (translateCTM dx dy ctm)+translateLabel dx dy (PrimLabel txt opt_id ctm) = +    PrimLabel txt opt_id (translateCTM dx dy ctm)  -------------------------------------------------------------------------------- -- Ellipse@@ -852,9 +860,21 @@ -- | Is the label empty - if so we might want to avoid printing it. -- isEmptyLabel :: PrimLabel -> Bool-isEmptyLabel (PrimLabel txt _) = body txt+isEmptyLabel (PrimLabel txt _ _) = body txt    where      body (StdLayout esc) = destrEscapedText null esc      body (KernTextH xs)  = null xs      body (KernTextV xs)  = null xs ++-- | Annotate a Primitive with an @id@ for SVG.+--+-- Note - for @PLabel@ this /pushes/ the id /inside/ the +-- constructor, for other elements the the id adds an extra layer +-- of nesting via the SVG group \<g\> tag.+-- +pushXIdAnno :: String -> Primitive -> Primitive+pushXIdAnno ss (PLabel props (PrimLabel txt _ ctm )) = +    PLabel props $ PrimLabel txt (Just ss) ctm+ +pushXIdAnno ss prim                                  = PSVG (SvgId ss) prim
src/Wumpus/Core/VersionNumber.hs view
@@ -22,7 +22,7 @@  -- | Version number. ----- > (0,51,0)+-- > (0,52,0) -- wumpus_core_version :: (Int,Int,Int)-wumpus_core_version = (0,51,0)+wumpus_core_version = (0,52,0)
src/Wumpus/Core/WumpusTypes.hs view
@@ -37,6 +37,7 @@   , FontCtx   , Primitive   , XLink+  , SvgAttr   , PrimPath   , PrimPathSegment   , AbsPathSegment
wumpus-core.cabal view
@@ -1,5 +1,5 @@ name:             wumpus-core-version:          0.51.0+version:          0.52.0 license:          BSD3 license-file:     LICENSE copyright:        Stephen Tetley <stephen.tetley@gmail.com>@@ -47,6 +47,21 @@   .     .   Changelog:+  . +  v0.51.0 to v0.52.0:+  .+  * Added limited support for adding SVG ids to text and +    Primitives.+  .+  * Fixed types of @d2r@ and @r2d@ to Double for degrees, rather +    than a parametric (Real a, Floating a) type. Although this is+    less general, it removes the burden of type annotating the +    common case.+  .+  * Added the vector functions @orthoVec@, @vsum@ and @vdiff@ to +    @Core.Geometry@.+  .+  * Re-named @clip@ to @clipPrimitive@   .   v0.50.0 to v0.51.0:   .