diff --git a/src/Wumpus/Core/Geometry.hs b/src/Wumpus/Core/Geometry.hs --- a/src/Wumpus/Core/Geometry.hs +++ b/src/Wumpus/Core/Geometry.hs @@ -54,6 +54,7 @@ , tCompare -- * Vector operations + , zeroVec , vec , hvec , vvec @@ -497,7 +498,17 @@ -------------------------------------------------------------------------------- -- Vectors +-- | Construct a the empty vector (0,0). +-- +-- Note - this is equivalent to @zeroV@ in @Data.AdditiveGroup@. +-- It is provided here for convenience as it may save an extra +-- module import in client code. +-- +zeroVec :: Num u => Vec2 u +zeroVec = V2 0 0 + + -- | 'vec' : @ x_component * y_component -> Vec2 @ -- -- A synonym for the constructor 'V2' with a Num constraint on @@ -631,6 +642,16 @@ lineDirection :: (Floating u, Real u) => Point2 u -> Point2 u -> Radian lineDirection (P2 x1 y1) (P2 x2 y2) = step (x2 - x1) (y2 - y1) where + -- Special cases for continuity - the equality test should + -- catch both 0.0 and (-0.0). + -- Note - there is undoubtedly a better way of doing this. + + step x y | x == 0 && y == 0 = 0 + + step x y | x == 0 = if y >=0 then 0.5*pi else 1.5*pi + + step x y | y == 0 = if x >=0 then 0 else pi + -- north-east quadrant step x y | pve x && pve y = toRadian $ atan (y/x) diff --git a/src/Wumpus/Core/GraphicProps.hs b/src/Wumpus/Core/GraphicProps.hs --- a/src/Wumpus/Core/GraphicProps.hs +++ b/src/Wumpus/Core/GraphicProps.hs @@ -72,17 +72,63 @@ -- | Line cap - default in output is butt. -- +-- > Cap Butt: +-- +-- > .-------. +-- > |=======| +-- > '-------' +-- +-- > Cap Round: +-- +-- > .-------. +-- > ( ======= ) +-- > '-------' +-- +-- > Cap Square: +-- +-- > .---------. +-- > | ======= | +-- > '---------' +-- data LineCap = CapButt | CapRound | CapSquare deriving (Enum,Eq,Show) -- | Line join - default in output is miter. -- +-- > Join Miter: +-- +-- > /\ +-- > /..\ +-- > /./\.\ +-- > /./ \.\ +-- > /./ \.\ +-- +-- > Join Round: +-- +-- > \.\ +-- > \.\ +-- > ,.) +-- > /./ +-- > /./ +-- +-- > Join Bevel: +-- +-- > __ +-- > /..\ +-- > /./\.\ +-- > /./ \.\ +-- > /./ \.\ +-- 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. +-- +-- > Solid -- +-- > Dash offset [(on,off )..] +-- data DashPattern = Solid | Dash Int [(Int,Int)] deriving (Eq,Show) @@ -92,8 +138,7 @@ -- 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: +-- For PostScript, the following fonts are expected to exist: -- -- > Times-Roman Times-Italic Times-Bold Times-BoldOtalic -- > Helvetica Helvetica-Oblique Helvetica-Bold Helvetica-Bold-Oblique @@ -157,6 +202,15 @@ -- of the shape. The actual size depends on the thickness -- of the line (stroke width). -- +-- > CFill - closed path filled with the colour. +-- +-- > CStroke - closed path, stroked with the colour. +-- +-- > OStroke - open path, stroked with the colour. +-- +-- > CFillStroke - closed path, filled with the first colour, +-- > stroked with the stroke attributes and second colour. +-- data PathProps = CFill RGBi | CStroke StrokeAttr RGBi | OStroke StrokeAttr RGBi @@ -176,6 +230,13 @@ -- | Ellipses and circles are always closed. +-- +-- > EFill - filled ellipse. +-- +-- > EStroke - stroked ellipse. +-- +-- > EFillStroke - ellipse filled with the first colour and stroked +-- > with the stroke attributes and second colour. -- data EllipseProps = EFill RGBi | EStroke StrokeAttr RGBi diff --git a/src/Wumpus/Core/OutputSVG.hs b/src/Wumpus/Core/OutputSVG.hs --- a/src/Wumpus/Core/OutputSVG.hs +++ b/src/Wumpus/Core/OutputSVG.hs @@ -13,17 +13,15 @@ -- -- Output SVG. -- --- This is complicated by two differences with PostScript. +-- Note - the coordinate systems of Wumpus and SVG are different. -- --- 1. The coordinate space of SVG is /origin top-left/, for --- PostScript it is /origin bottom-left/. --- --- 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)\"@. +-- > Wumpus - (0,0) is bottom-left. -- +-- > SVG - (0,0) is top-left. -- +-- To accommodate this, Wumpus adds rectifying matrix +-- transformations to the generated SVG code. +-- -------------------------------------------------------------------------------- module Wumpus.Core.OutputSVG @@ -58,6 +56,21 @@ import qualified Data.Map as Map import Data.Maybe + +-- DESIGN NOTE +-- +-- SVG output is complicated by two differences with PostScript. +-- +-- 1. The coordinate space of SVG is /origin top-left/, for +-- PostScript it is /origin bottom-left/. +-- +-- 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)\"@. +-- + + -- SvgMonad is two Readers plus Int state for clip paths... -- @@ -146,10 +159,15 @@ writeSVG filepath pic = writeFile filepath $ show $ svgDraw Nothing pic + + -- | 'writeSVG_defs' : @ file_name -> defs -> picture -> IO () @ -- -- Output a picture to a SVG file the supplied /defs/ are -- written into the defs section of SVG file verbatim. +-- +-- This is considered an experimental feature, use 'writeSVG' +-- instead. -- writeSVG_defs :: FilePath -> String -> Picture -> IO () writeSVG_defs filepath ss pic = diff --git a/src/Wumpus/Core/Picture.hs b/src/Wumpus/Core/Picture.hs --- a/src/Wumpus/Core/Picture.hs +++ b/src/Wumpus/Core/Picture.hs @@ -134,7 +134,7 @@ -- -- The order of the list maps to the order of printing - the -- front of the list is drawn first in the file. This also means --- that the front of the list is drawn /at the back/ in the +-- that the front of the list is drawn /underneath/ in the -- Z-Order. -- -- \*\* WARNING \*\* - this function throws a runtime error when @@ -198,7 +198,8 @@ -- | 'absPrimPath' : @ start_point * [abs_path_segment] -> PrimPath @ -- --- Create a Path from a start point and a list of AbsPathSegments. +-- Create a 'PrimPath' from a start point and a list of /absolute/ +-- path segments. -- absPrimPath :: DPoint2 -> [AbsPathSegment] -> PrimPath absPrimPath pt xs = PrimPath (step pt xs) (startPointCTM pt) @@ -214,7 +215,7 @@ -- | 'absLineTo' : @ end_point -> path_segment @ -- --- Create a straight-line PathSegment, the start point is +-- Create a straight-line 'AbsPathSegment', the start point is -- implicitly the previous point in a path. -- absLineTo :: DPoint2 -> AbsPathSegment @@ -223,8 +224,8 @@ -- | 'absCurveTo' : @ control_point1 * control_point2 * end_point -> -- path_segment @ -- --- Create a curved PathSegment, the start point is implicitly the --- previous point in a path. +-- Create a curved 'AbsPathSegment', the start point is implicitly +-- the previous point in a path. -- -- absCurveTo :: DPoint2 -> DPoint2 -> DPoint2 -> AbsPathSegment @@ -233,8 +234,13 @@ -- | 'relPrimPath' : @ start_point * [rel_path_segment] -> PrimPath @ -- --- Create a Path from a start point and a list of RelPathSegments. +-- Create a 'PrimPath' from a start point and a list of /relative/ +-- path segments. -- +-- Note - internally Wumpus works with relative paths so +-- constructing them directly with 'relPrimPath' is more efficient +-- than using 'absPrimPath'. +-- relPrimPath :: DPoint2 -> [PrimPathSegment] -> PrimPath relPrimPath pt xs = PrimPath xs (startPointCTM pt) @@ -242,7 +248,7 @@ -- | 'relLineTo' : @ vec_to_end -> path_segment @ -- --- Create a straight-line relative PathSegment, the vector is the +-- Create a straight-line 'PrimPathSegment', the vector is the -- relative displacement. -- relLineTo :: DVec2 -> PrimPathSegment @@ -251,7 +257,7 @@ -- | 'relCurveTo' : @ vec_to_cp1 * vec_to_cp2 * vec_to_end -> -- path_segment @ -- --- Create a curved relative PathSegment. +-- Create a curved 'RelPathSegment'. -- -- relCurveTo :: DVec2 -> DVec2 -> DVec2 -> PrimPathSegment @@ -318,14 +324,19 @@ in RelCurveTo v1 v2 v3 : step c ys step _ _ = [] + -- | Create a hyperlink for SVG output. -- +-- Note - hyperlinks are ignored in the PostScript output. +-- xlinkhref :: String -> XLink xlinkhref = XLink -- | Create a hyperlinked Primitive. -- +-- Note - hyperlinks are ignored in the PostScript output. +-- xlinkPrim :: XLink -> Primitive -> Primitive xlinkPrim hypl p = PSVG (ALink hypl) p @@ -410,7 +421,7 @@ -- | 'ostroke' : @ rgb * stroke_attr * path -> Primitive @ -- --- Create a open, stroked path. +-- Create an open, stroked path from the 'PrimPath' specification. -- ostroke :: RGBi -> StrokeAttr -> PrimPath -> Primitive ostroke rgb sa p = PPath (OStroke sa rgb) p @@ -418,7 +429,7 @@ -- | 'cstroke' : @ rgb * stroke_attr * path -> Primitive @ -- --- Create a closed, stroked path. +-- Create a closed, stroked path from the 'PrimPath' specfication. -- cstroke :: RGBi -> StrokeAttr -> PrimPath -> Primitive cstroke rgb sa p = PPath (CStroke sa rgb) p @@ -446,14 +457,15 @@ -- | 'fill' : @ rgb * path -> Primitive @ -- --- Create a filled path. +-- Create a filled path from the 'PrimPath' specification. -- fill :: RGBi -> PrimPath -> Primitive fill rgb p = PPath (CFill rgb) p -- | 'zfill' : @ path -> Primitive @ -- --- Create a filled path coloured black. +-- Draw a filled path coloured black. +-- zfill :: PrimPath -> Primitive zfill = fill black @@ -478,7 +490,7 @@ -- | 'clip' : @ path * primitive -> Primitive @ -- --- Clip a primitive with respect to the supplied path. +-- Clip a primitive to be inside the supplied path. -- clip :: PrimPath -> Primitive -> Primitive clip cp p = PClip cp p diff --git a/src/Wumpus/Core/PictureInternal.hs b/src/Wumpus/Core/PictureInternal.hs --- a/src/Wumpus/Core/PictureInternal.hs +++ b/src/Wumpus/Core/PictureInternal.hs @@ -186,6 +186,7 @@ | SvgAG XLink [SvgAttr] deriving (Eq,Show) + -- | Primitives can be grouped with hyperlinks in SVG output. -- -- Note - this is always printed as @xlink:href="..."@. Other @@ -203,16 +204,49 @@ -- properties. Graphical properties (fill_colour, font_size, etc.) -- should be set through the appropriate Wumpus functions. -- +-- Also note, this functionality is has not been widely used. It +-- might be something of a white elephant. +-- data SvgAttr = SvgAttr { svg_attr_name :: String , svg_attr_value :: String } deriving (Eq,Show) --- | PrimPath - a list of path segments and a CTM. + +-- | PrimPath - a list of path segments and a CTM (translation +-- matrix). -- --- Start point is the dx - dy of the CTM. +-- The start point of the path forms the (dx,dy) of the CTM. The +-- CTM is otherwise hidden from the public constructors of this +-- data type. +-- +-- Note - the PrimPath type does not support concatenation. +-- It is expected that all PrimPaths will be created /in one go/, +-- and client code defines a higher-level path type that supports +-- concatenation, splitting etc. -- +-- Primitively paths can be built like this: +-- +-- > +-- > path1 :: PrimPath +-- > path1 = absPrimPath zeroPt [ absLineTo (P2 0 60) +-- > , absLineTo (P2 40 100) +-- > , absLineTo (P2 80 60) +-- > , absLineTo (P2 80 0) +-- > , absLineTo (P2 60 0) +-- > , absLineTo (P2 60 30) +-- > , absCurveTo (P2 60 50) (P2 50 60) (P2 40 60) +-- > , absCurveTo (P2 30 60) (P2 20 50) (P2 20 30) +-- > , absLineTo (P2 20 0) +-- > ] +-- > +-- +-- Although it\'s generally expected that PrimPaths will be +-- constructed by traversing a higher-level path object and +-- collecting calls to the @absCurevTo@ and @absLineTo@ functions +-- in a list. +-- data PrimPath = PrimPath [PrimPathSegment] PrimCTM deriving (Eq,Show) diff --git a/src/Wumpus/Core/VersionNumber.hs b/src/Wumpus/Core/VersionNumber.hs --- a/src/Wumpus/Core/VersionNumber.hs +++ b/src/Wumpus/Core/VersionNumber.hs @@ -22,7 +22,7 @@ -- | Version number. -- --- > (0,50,0) +-- > (0,51,0) -- wumpus_core_version :: (Int,Int,Int) -wumpus_core_version = (0,50,0) +wumpus_core_version = (0,51,0) diff --git a/wumpus-core.cabal b/wumpus-core.cabal --- a/wumpus-core.cabal +++ b/wumpus-core.cabal @@ -1,5 +1,5 @@ name: wumpus-core -version: 0.50.0 +version: 0.51.0 license: BSD3 license-file: LICENSE copyright: Stephen Tetley @@ -47,6 +47,15 @@ . . Changelog: + . + v0.50.0 to v0.51.0: + . + * Added special cases to handle continuity to the function + @lineDirection@ in @Core.Geometry@. + . + * Added @zeroVec@ to @Core.Geometry@. + . + * Extended some Haddock documentation. . v0.43.0 to v0.50.0: .