wumpus-core 0.18.0 → 0.19.0

raw patch · 14 files changed

+527/−311 lines, 14 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES +32/−0
• demo/MultiPic.hs +33/−0
• src/Wumpus/Core/AffineTrans.hs +20/−7
• src/Wumpus/Core/BoundingBox.hs +28/−29
• src/Wumpus/Core/Geometry.hs +130/−71
• src/Wumpus/Core/OneList.hs +139/−0
• src/Wumpus/Core/OutputPostScript.hs +3/−2
• src/Wumpus/Core/OutputSVG.hs +6/−2
• src/Wumpus/Core/Picture.hs +30/−14
• src/Wumpus/Core/PictureInternal.hs +35/−24
• src/Wumpus/Core/Utils.hs +8/−83
• src/Wumpus/Core/VersionNumber.hs +1/−1
• src/Wumpus/Extra/SVGColours.hs +1/−1
• wumpus-core.cabal +61/−77

@@ -1,3 +1,35 @@++0.18,0 to 0.19.0:+  +  * Added @Transform@ type class to apply a matrix transformation+    directly.+  +  * Changed the ordering of picture drawing in PostScript and SVG+    output so the list gets drawn from tail to head with right +    folds. This makes the list order of pictures match their +    zorder.+  +  * Renamed the function @withinBB@ (Core.BoundingBox) to +    @within@.+  +  * On many type signatures with e.g. Points, I\'ve changed the +    parameter name on the type constructor from @a@ to @u@.+    This is to indicate that @u@ is some unit - almost always a+    Double. e.g @Point2 a@ becomes @Point2 u@ and all the class+    obligations change lexically as well @Floating a =>@ to +    @Floating u =>@. Superficially this means a lot of type +    signatures have diffs but haven\'t really changed. +  +  * Added function @bezierCircle@ to generate the Bezier curve +    points for arcs describing a circle.+  +  * Added new demo - MultiPic. The PostScript it generates+    is efficient - no extraneous use of @concat@. +  +  * Added wumpus_default_font constant.+  ++ 0.17.0 to 0.18.0:      * Added instances of the affine operation classes (Scale, 

@@ -0,0 +1,33 @@+{-# OPTIONS -Wall #-}++module MultiPic where++import Wumpus.Core+import Wumpus.Core.Colour++import Data.AffineSpace++main :: IO ()+main = do +  writeEPS_latin1 "./out/multi_pic.eps"  pic1+  writeSVG_latin1 "./out/multi_pic.svg"  pic1++++pic1 :: DPicture+pic1 = uniformScale 2 $ frameMulti $ +    [ ellipse blue 10 10 zeroPt+    , ellipse red 10 10 (P2 40 40)+    , ztextlabel "Wumpus!" (P2 40 20)+    , square red 5 (P2 50 10)  +    ]+++square :: (Num u, Ord u) => DRGB -> u -> Point2 u -> Primitive u+square rgb sidelen bl = fill rgb $ vertexPath $+    [bl, bl .+^ hvec sidelen, bl .+^ V2 sidelen sidelen, bl .+^ vvec sidelen]++-- The PostScript generated from this is pretty good.+-- +-- No extraneous use of @concat@.+--

@@ -38,7 +38,8 @@ module Wumpus.Core.AffineTrans   (    -- * Type classes-    Rotate(..)+    Transform(..)+  , Rotate(..)   , RotateAbout(..)   , Scale(..)   , Translate(..)@@ -76,29 +77,41 @@ -------------------------------------------------------------------------------- -- Affine transformations  +-- | Apply a matrix trasnformation directly.+class Transform t where+  transform :: u ~ DUnit t => Matrix3'3 u -> t -> t ++ -- | Type class for rotation.+--  class Rotate t where   rotate :: Radian -> t -> t +instance Num u => Transform (Point2 u) where+  transform ctm = (ctm *#) -instance (Floating a, Real a) => Rotate (Point2 a) where+instance Num u => Transform (Vec2 u) where+  transform ctm = (ctm *#)+++instance (Floating u, Real u) => Rotate (Point2 u) where   rotate a = ((rotationMatrix a) *#) -instance (Floating a, Real a) => Rotate (Vec2 a) where+instance (Floating u, Real u) => Rotate (Vec2 u) where   rotate a = ((rotationMatrix a) *#)   -- | Type class for rotation about a point. class RotateAbout t where-  rotateAbout :: Radian -> Point2 (DUnit t) -> t -> t +  rotateAbout :: u ~ DUnit t =>  Radian -> Point2 u -> t -> t   -instance (Floating a, Real a) => RotateAbout (Point2 a) where+instance (Floating u, Real u) => RotateAbout (Point2 u) where   rotateAbout a pt = ((originatedRotationMatrix a pt) *#)   -instance (Floating a, Real a) => RotateAbout (Vec2 a) where+instance (Floating u, Real u) => RotateAbout (Vec2 u) where   rotateAbout a pt = ((originatedRotationMatrix a pt) *#)     --------------------------------------------------------------------------------@@ -106,7 +119,7 @@  -- | Type class for scaling. class Scale t where-  scale :: DUnit t -> DUnit t -> t -> t+  scale :: u ~ DUnit t => u -> u -> t -> t  instance Num u => Scale (Point2 u) where   scale x y = ((scalingMatrix x y) *#) 

@@ -40,7 +40,7 @@   , retrace    , corners-  , withinBB+  , within   , boundaryWidth   , boundaryHeight   , boundaryBottomLeft@@ -57,7 +57,6 @@  import Wumpus.Core.AffineTrans import Wumpus.Core.Geometry-import Wumpus.Core.Utils ( CMinMax(..), within )  import Data.Semigroup @@ -72,9 +71,9 @@ -- spared the obligation to be /empty/. BoundingBox is an instance -- of the Semigroup class where @append@ is the union operation. -- -data BoundingBox a = BBox -      { ll_corner :: Point2 a-      , ur_corner :: Point2 a +data BoundingBox u = BBox +      { ll_corner :: Point2 u+      , ur_corner :: Point2 u        }   deriving (Eq,Show) @@ -87,11 +86,11 @@  -- BBox is NOT monoidal - it\'s much simpler that way. -instance Ord a => Semigroup (BoundingBox a) where+instance Ord u => Semigroup (BoundingBox u) where   append = union  -instance Pretty a => Pretty (BoundingBox a) where+instance Pretty u => Pretty (BoundingBox u) where   pretty (BBox p0 p1) = text "|_" <+> pretty p0 <+> pretty p1 <+> text "_|"   @@ -113,14 +112,14 @@ -- Picture, Path etc. -- class Boundary a where-  boundary :: a -> BoundingBox (DUnit a)+  boundary :: DUnit a ~ u => a -> BoundingBox u    --------------------------------------------------------------------------------  -instance Pointwise (BoundingBox a) where-  type Pt (BoundingBox a) = Point2 a+instance Pointwise (BoundingBox u) where+  type Pt (BoundingBox u) = Point2 u   pointwise f (BBox bl tr) = BBox (f bl) (f tr)  @@ -132,7 +131,7 @@ -- @bbox@ throws an error if the width or height of the  -- constructed bounding box is negative. ---bbox :: Ord a => Point2 a -> Point2 a -> BoundingBox a+bbox :: Ord u => Point2 u -> Point2 u -> BoundingBox u bbox ll@(P2 x0 y0) ur@(P2 x1 y1)     | x0 <= x1 && y0 <= y1 = BBox ll ur     | otherwise            = error "Wumpus.Core.BoundingBox.bbox - malformed."@@ -141,15 +140,15 @@ -- | Create a BoundingBox with bottom left corner at the origin, -- and dimensions @w@ and @h@. ---obbox :: Num a => a -> a -> BoundingBox a+obbox :: Num u => u -> u -> BoundingBox u obbox w h = BBox zeroPt (P2 w h)   -- | The union of two bounding boxes. This is also the @append@  -- of BoundingBox\'s @Semigroup@ instance. ---union :: Ord a => BoundingBox a -> BoundingBox a -> BoundingBox a-BBox ll ur `union` BBox ll' ur' = BBox (cmin ll ll') (cmax ur ur')+union :: Ord u => BoundingBox u -> BoundingBox u -> BoundingBox u+BBox ll ur `union` BBox ll' ur' = BBox (minPt ll ll') (maxPt ur ur')  -- | Trace a list of points, retuning the BoundingBox that  -- includes them.@@ -157,8 +156,8 @@ -- 'trace' throws a run-time error when supplied with the empty  -- list. ---trace :: (Num a, Ord a) => [Point2 a] -> BoundingBox a-trace (p:ps) = uncurry BBox $ foldr (\z (a,b) -> (cmin z a, cmax z b) ) (p,p) ps+trace :: (Num u, Ord u) => [Point2 u] -> BoundingBox u+trace (p:ps) = uncurry BBox $ foldr (\z (a,b) -> (minPt z a, maxPt z b) ) (p,p) ps trace []     = error $ "BoundingBox.trace called in empty list"  -- | Perform the supplied transformation on the four corners of @@ -177,24 +176,24 @@  -- | Generate all the corners of a bounding box, counter-clock  -- wise from the bottom left, i.e. @(bl, br, tr, tl)@.-corners :: BoundingBox a -> (Point2 a, Point2 a, Point2 a, Point2 a)+corners :: BoundingBox u -> (Point2 u, Point2 u, Point2 u, Point2 u) corners (BBox bl@(P2 x0 y0) tr@(P2 x1 y1)) = (bl, br, tr, tl) where     br = P2 x1 y0     tl = P2 x0 y1  -- | Within test - is the supplied point within the bounding box? ---withinBB :: Ord a => Point2 a -> BoundingBox a -> Bool-withinBB p (BBox ll ur) = within p ll ur+within :: Ord u => Point2 u -> BoundingBox u -> Bool+within p (BBox ll ur) = (minPt p ll) == ll && (maxPt p ur) == ur  -- | Extract the width of a bounding box. ---boundaryWidth :: Num a => BoundingBox a -> a+boundaryWidth :: Num u => BoundingBox u -> u boundaryWidth (BBox (P2 xmin _) (P2 xmax _)) = xmax - xmin  -- | Extract the height of a bounding box. ---boundaryHeight :: Num a => BoundingBox a -> a+boundaryHeight :: Num u => BoundingBox u -> u boundaryHeight (BBox (P2 _ ymin) (P2 _ ymax)) = ymax - ymin  @@ -203,19 +202,19 @@ -- Points on the boundary  -- | Extract the bottom-left corner of the bounding box.-boundaryBottomLeft  :: BoundingBox a -> Point2 a+boundaryBottomLeft  :: BoundingBox u -> Point2 u boundaryBottomLeft (BBox p0 _ ) = p0  -- | Extract the top-right corner of the bounding box.-boundaryTopRight :: BoundingBox a -> Point2 a+boundaryTopRight :: BoundingBox u -> Point2 u boundaryTopRight (BBox _ p1) = p1  -- | Extract the top-left corner of the bounding box.-boundaryTopLeft :: BoundingBox a -> Point2 a+boundaryTopLeft :: BoundingBox u -> Point2 u boundaryTopLeft (BBox (P2 x _) (P2 _ y)) = P2 x y  -- | Extract the bottom-right corner of the bounding box.-boundaryBottomRight :: BoundingBox a -> Point2 a+boundaryBottomRight :: BoundingBox u -> Point2 u boundaryBottomRight (BBox (P2 _ y) (P2 x _)) = P2 x y  @@ -228,19 +227,19 @@ -- Are these really worthwhile ? ...  -- | Extract the unit of the left vertical plane.-leftPlane :: BoundingBox a -> a+leftPlane :: BoundingBox u -> u leftPlane (BBox (P2 l _) _) = l  -- | Extract the unit of the right vertical plane.-rightPlane :: BoundingBox a -> a+rightPlane :: BoundingBox u -> u rightPlane (BBox _ (P2 r _)) = r  -- | Extract the unit of the lower horizontal plane.-lowerPlane :: BoundingBox a -> a+lowerPlane :: BoundingBox u -> u lowerPlane (BBox (P2 _ l) _) = l  -- | Extract the unit of the upper horizontal plane.-upperPlane :: BoundingBox a -> a+upperPlane :: BoundingBox u -> u upperPlane (BBox _ (P2 _ u)) = u  

@@ -58,6 +58,8 @@    -- * Point operations   , zeroPt+  , minPt+  , maxPt   , langle    -- * Frame operations@@ -91,10 +93,11 @@    -- * Bezier curves   , bezierArc+  , bezierCircle    ) where -import Wumpus.Core.Utils ( CMinMax(..), PSUnit(..), oo )+import Wumpus.Core.Utils ( PSUnit(..), oo )   import Data.AffineSpace@@ -117,16 +120,18 @@ -- Datatypes   -- | 2D Vector - both components are strict.-data Vec2 a = V2 !a !a+--+data Vec2 u = V2 !u !u   deriving (Eq,Show)  type DVec2 = Vec2 Double  -- | 2D Point - both components are strict. -- --- Point2 derives Ord so it can be used as a key in Data.Map etc.+-- Note - Point2 derives Ord so it can be used as a key in +-- Data.Map etc. ---data Point2 a = P2 !a !a+data Point2 u = P2 !u !u   deriving (Eq,Ord,Show)  type DPoint2 = Point2 Double@@ -143,7 +148,7 @@ -- > Frame2 (V2 e0x e0y) (V2 e1x e1y) (P2 ox oy) --  -data Frame2 a = Frame2 (Vec2 a) (Vec2 a) (Point2 a)+data Frame2 u = Frame2 (Vec2 u) (Vec2 u) (Point2 u)   deriving (Eq,Show)  type DFrame2 = Frame2 Double@@ -184,7 +189,7 @@ --   -data Matrix3'3 a = M3'3 !a !a !a  !a !a !a  !a !a !a+data Matrix3'3 u = M3'3 !u !u !u  !u !u !u  !u !u !u   deriving (Eq)  type DMatrix3'3 = Matrix3'3 Double@@ -201,19 +206,19 @@ -------------------------------------------------------------------------------- -- Family instances -type instance DUnit (Point2 a)    = a-type instance DUnit (Vec2 a)      = a-type instance DUnit (Frame2 a)    = a-type instance DUnit (Matrix3'3 a) = a+type instance DUnit (Point2 u)    = u+type instance DUnit (Vec2 u)      = u+type instance DUnit (Frame2 u)    = u+type instance DUnit (Matrix3'3 u) = u  -------------------------------------------------------------------------------- -- lifters / convertors -lift2Vec2 :: (a -> a -> a) -> Vec2 a -> Vec2 a -> Vec2 a+lift2Vec2 :: (u -> u -> u) -> Vec2 u -> Vec2 u -> Vec2 u lift2Vec2 op (V2 x y) (V2 x' y') = V2 (x `op` x') (y `op` y')  -lift2Matrix3'3 :: (a -> a -> a) -> Matrix3'3 a -> Matrix3'3 a -> Matrix3'3 a+lift2Matrix3'3 :: (u -> u -> u) -> Matrix3'3 u -> Matrix3'3 u -> Matrix3'3 u lift2Matrix3'3 op (M3'3 a b c d e f g h i) (M3'3 m n o p q r s t u) =        M3'3 (a `op` m) (b `op` n) (c `op` o)              (d `op` p) (e `op` q) (f `op` r)  @@ -242,27 +247,27 @@  -- Vectors have a sensible Monoid instance as addition, points don't -instance Num a => Monoid (Vec2 a) where+instance Num u => Monoid (Vec2 u) where   mempty  = V2 0 0   mappend = lift2Vec2 (+)    -- Affine frames also have a sensible Monoid instance -instance (Num a, InnerSpace (Vec2 a)) => Monoid (Frame2 a) where+instance (Num u, InnerSpace (Vec2 u)) => Monoid (Frame2 u) where   mempty = ortho zeroPt   mappend = frameProduct   -- Show -instance Show a => Show (Matrix3'3 a) where+instance Show u => Show (Matrix3'3 u) where   show (M3'3 a b c d e f g h i) = "(M3'3 " ++ body ++ ")" where     body = show [[a,b,c],[d,e,f],[g,h,i]]  -- Num -instance Num a => Num (Matrix3'3 a) where+instance Num u => Num (Matrix3'3 u) where   (+) = lift2Matrix3'3 (+)    (-) = lift2Matrix3'3 (-) @@ -290,19 +295,19 @@ -------------------------------------------------------------------------------- -- Pretty printing -instance Pretty a => Pretty (Vec2 a) where+instance Pretty u => Pretty (Vec2 u) where   pretty (V2 a b) = angles (char '|' <+> pretty a <+> pretty b <+> char '|') -instance Pretty a => Pretty (Point2 a) where+instance Pretty u => Pretty (Point2 u) where   pretty (P2 a b) = brackets (char '|' <+> pretty a <+> pretty b <+> char '|') -instance Pretty a => Pretty (Frame2 a) where+instance Pretty u => Pretty (Frame2 u) where   pretty (Frame2 e0 e1 o) = braces $         text "e0:" <> pretty e0     <+> text "e1:" <> pretty e1     <+> text "o:" <> pretty o -instance PSUnit a => Pretty (Matrix3'3 a) where+instance PSUnit u => Pretty (Matrix3'3 u) where   pretty (M3'3 a b c  d e f  g h i) =        matline a b c <$> matline d e f <$> matline g h i     where@@ -317,38 +322,38 @@ -------------------------------------------------------------------------------- -- Vector space instances -instance Num a => AdditiveGroup (Vec2 a) where+instance Num u => AdditiveGroup (Vec2 u) where   zeroV = V2 0 0    (^+^) = lift2Vec2 (+)     negateV = fmap negate   -instance Num a => VectorSpace (Vec2 a) where-  type Scalar (Vec2 a) = a+instance Num u => VectorSpace (Vec2 u) where+  type Scalar (Vec2 u) = u   s *^ v = fmap (s*) v   -- scalar (dot / inner) product via the class InnerSpace -instance (Num a, InnerSpace a, Scalar a ~ a) -    => InnerSpace (Vec2 a) where+instance (Num u, InnerSpace u, Scalar u ~ u) +    => InnerSpace (Vec2 u) where   (V2 a b) <.> (V2 a' b') = (a <.> a') ^+^ (b <.> b')  -instance Num a => AffineSpace (Point2 a) where-  type Diff (Point2 a) = Vec2 a+instance Num u => AffineSpace (Point2 u) where+  type Diff (Point2 u) = Vec2 u   (P2 a b) .-. (P2 x y)   = V2 (a-x)  (b-y)   (P2 a b) .+^ (V2 vx vy) = P2 (a+vx) (b+vy)  -instance Num a => AdditiveGroup (Matrix3'3 a) where+instance Num u => AdditiveGroup (Matrix3'3 u) where   zeroV = fromInteger 0   (^+^) = (+)   negateV = negate  -instance Num a => VectorSpace (Matrix3'3 a) where-  type Scalar (Matrix3'3 a) = a+instance Num u => VectorSpace (Matrix3'3 u) where+  type Scalar (Matrix3'3 u) = u   s *^ m = fmap (s*) m   --------------------------------------------------------------------------------@@ -371,20 +376,15 @@   type Pt [a] = Pt a   pointwise f pts = map (pointwise f) pts  -instance Pointwise (Vec2 a) where-  type Pt (Vec2 a) = Vec2 a+instance Pointwise (Vec2 u) where+  type Pt (Vec2 u) = Vec2 u   pointwise f v = f v -instance Pointwise (Point2 a) where-  type Pt (Point2 a) = Point2 a+instance Pointwise (Point2 u) where+  type Pt (Point2 u) = Point2 u   pointwise f pt = f pt --------------------------------------------------------------------------------- -instance Ord a => CMinMax (Point2 a) where-  cmin (P2 x y) (P2 x' y') = P2 (min x x') (min y y')-  cmax (P2 x y) (P2 x' y') = P2 (max x x') (max y y')- -------------------------------------------------------------------------------- -- Matrix multiply @@ -394,14 +394,14 @@ -- represented as homogeneous coordinates.  -- class MatrixMult t where -  (*#) :: DUnit t ~ a => Matrix3'3 a -> t -> t+  (*#) :: DUnit t ~ u => Matrix3'3 u -> t -> t  -instance Num a => MatrixMult (Vec2 a) where       +instance Num u => MatrixMult (Vec2 u) where          (M3'3 a b c d e f _ _ _) *# (V2 m n) = V2 (a*m+b*n+c*0) (d*m+e*n+f*0)  -instance Num a => MatrixMult (Point2 a) where+instance Num u => MatrixMult (Point2 u) where   (M3'3 a b c d e f _ _ _) *# (P2 m n) = P2 (a*m+b*n+c*1) (d*m+e*n+f*1)  --------------------------------------------------------------------------------@@ -411,19 +411,22 @@ -- | Direction of a vector - i.e. the counter-clockwise angle  -- from the x-axis. ---direction :: (Floating a, Real a) => Vec2 a -> Radian+direction :: (Floating u, Real u) => Vec2 u -> Radian direction (V2 x y) = langle (P2 0 0) (P2 x y)  -- | Construct a vector with horizontal displacement.-hvec :: Num a => a -> Vec2 a+--+hvec :: Num u => u -> Vec2 u hvec d = V2 d 0  -- | Construct a vector with vertical displacement.-vvec :: Num a => a -> Vec2 a+--+vvec :: Num u => u -> Vec2 u vvec d = V2 0 d  -- | Construct a vector from an angle and magnitude.-avec :: Floating a => Radian -> a -> Vec2 a+--+avec :: Floating u => Radian -> u -> Vec2 u avec theta d = V2 x y where   ang = fromRadian theta   x   = d * cos ang@@ -434,25 +437,50 @@ -- -- > pvec = flip (.-.) ---pvec :: Num a => Point2 a -> Point2 a -> Vec2 a+pvec :: Num u => Point2 u -> Point2 u -> Vec2 u pvec = flip (.-.)  -- | Extract the angle between two vectors. ---vangle :: (Floating a, Real a, InnerSpace (Vec2 a)) -       => Vec2 a -> Vec2 a -> Radian+vangle :: (Floating u, Real u, InnerSpace (Vec2 u)) +       => Vec2 u -> Vec2 u -> Radian vangle u v = realToFrac $ acos $ (u <.> v) / (on (*) magnitude u v)  -------------------------------------------------------------------------------- -- Points  -- | Construct a point at 0 0.-zeroPt :: Num a => Point2 a+--+zeroPt :: Num u => Point2 u zeroPt = P2 0 0 ++-- | /Component-wise/ min on points.  +-- Standard 'min' and 'max' via Ord are defined lexographically+-- on pairs, e.g.:+-- +-- > min (1,2) (2,1) = (1,2)+-- +-- For Points we want the component-wise min and max, e.g:+--+-- > minPt (P2 1 2) (Pt 2 1) = Pt 1 1 +-- > maxPt (P2 1 2) (Pt 2 1) = Pt 2 2+-- +minPt :: Ord u => Point2 u -> Point2 u -> Point2 u+minPt (P2 x y) (P2 x' y') = P2 (min x x') (min y y')++-- | /Component-wise/ max on points.  +--+-- > maxPt (P2 1 2) (Pt 2 1) = Pt 2 2+-- +maxPt :: Ord u => Point2 u -> Point2 u -> Point2 u+maxPt (P2 x y) (P2 x' y') = P2 (max x x') (max y y')++ -- | Calculate the counter-clockwise angle between two points  -- and the x-axis.-langle :: (Floating a, Real a) => Point2 a -> Point2 a -> Radian+--+langle :: (Floating u, Real u) => Point2 u -> Point2 u -> Radian langle (P2 x1 y1) (P2 x2 y2) = step (x2 - x1) (y2 - y1)   where     -- north-east quadrant @@ -476,16 +504,19 @@  -- | Create a frame with standard (orthonormal bases) at the  -- supplied point.-ortho :: Num a => Point2 a -> Frame2 a+--+ortho :: Num u => Point2 u -> Frame2 u ortho o = Frame2 (V2 1 0) (V2 0 1) o  -- | Displace the origin of the frame by the supplied vector.-displaceOrigin :: Num a => Vec2 a -> Frame2 a -> Frame2 a+--+displaceOrigin :: Num u => Vec2 u -> Frame2 u -> Frame2 u displaceOrigin v (Frame2 e0 e1 o) = Frame2 e0 e1 (o.+^v)  -- | \'World coordinate\' calculation of a point in the supplied -- frame.-pointInFrame :: Num a => Point2 a -> Frame2 a -> Point2 a+--+pointInFrame :: Num u => Point2 u -> Frame2 u -> Point2 u pointInFrame (P2 x y) (Frame2 vx vy o) = (o .+^ (vx ^* x)) .+^ (vy ^* y)    -- | Concatenate the elements of the frame as columns forming a@@ -502,7 +533,7 @@ -- >        0   0   1  ) -- -frame2Matrix :: Num a =>  Frame2 a -> Matrix3'3 a+frame2Matrix :: Num u =>  Frame2 u -> Matrix3'3 u frame2Matrix (Frame2 (V2 e0x e0y) (V2 e1x e1y) (P2 ox oy)) =      M3'3 e0x e1x ox            e0y e1y oy @@ -519,21 +550,24 @@ -- -- > Frame (V2 e0x e0y) (V2 e1x e1y) (P2 ox oy) -- -matrix2Frame :: Matrix3'3 a -> Frame2 a+matrix2Frame :: Matrix3'3 u -> Frame2 u matrix2Frame (M3'3 e0x e1x ox                     e0y e1y oy                    _   _   _ ) = Frame2 (V2 e0x e0y) (V2 e1x e1y) (P2 ox oy)   -- | /Multiplication/ of frames to form their product.-frameProduct :: (Num a, InnerSpace (Vec2 a)) => Frame2 a -> Frame2 a -> Frame2 a+--+frameProduct :: (Num u, InnerSpace (Vec2 u)) +             => Frame2 u -> Frame2 u -> Frame2 u frameProduct = matrix2Frame `oo` on (*) frame2Matrix    -- | Is the origin at (0,0) and are the basis vectors orthogonal  -- with unit length?-standardFrame :: Num a => Frame2 a -> Bool+--+standardFrame :: Num u => Frame2 u -> Bool standardFrame (Frame2 (V2 1 0) (V2 0 1) (P2 0 0)) = True standardFrame _                                   = False @@ -547,7 +581,7 @@ -- >       0 1 0 -- >       0 0 1 ) ---identityMatrix :: Num a => Matrix3'3 a+identityMatrix :: Num u => Matrix3'3 u identityMatrix = M3'3 1 0 0                         0 1 0                         0 0 1@@ -560,7 +594,7 @@ -- >       0  sy 0 -- >       0  0  1 ) ---scalingMatrix :: Num a => a -> a -> Matrix3'3 a+scalingMatrix :: Num u => u -> u -> Matrix3'3 u scalingMatrix sx sy = M3'3  sx 0  0                                0  sy 0                                0  0  1@@ -571,7 +605,7 @@ -- >       0  1  y -- >       0  0  1 ) ---translationMatrix :: Num a => a -> a -> Matrix3'3 a+translationMatrix :: Num u => u -> u -> Matrix3'3 u translationMatrix x y = M3'3 1 0 x                                0 1 y                                0 0 1@@ -582,7 +616,7 @@ -- >       sin(a)   cos(a)  y -- >       0        0       1 ) ---rotationMatrix :: (Floating a, Real a) => Radian -> Matrix3'3 a+rotationMatrix :: (Floating u, Real u) => Radian -> Matrix3'3 u rotationMatrix a = M3'3 (cos ang) (negate $ sin ang) 0                          (sin ang) (cos ang)          0                           0         0                  1@@ -600,8 +634,8 @@ -- (T being the translation matrix, R the rotation matrix and -- T^-1 the inverse of the translation matrix). ---originatedRotationMatrix :: (Floating a, Real a) -                         => Radian -> (Point2 a) -> Matrix3'3 a+originatedRotationMatrix :: (Floating u, Real u) +                         => Radian -> (Point2 u) -> Matrix3'3 u originatedRotationMatrix ang (P2 x y) = mT * (rotationMatrix ang) * mTinv   where     mT    = M3'3 1 0 x     @@ -615,15 +649,18 @@   -- | Invert a matrix.-invert :: Fractional a => Matrix3'3 a -> Matrix3'3 a +--+invert :: Fractional u => Matrix3'3 u -> Matrix3'3 u invert m = (1 / determinant m) *^ adjoint m  -- | Determinant of a matrix.-determinant :: Num a => Matrix3'3 a -> a+--+determinant :: Num u => Matrix3'3 u -> u determinant (M3'3 a b c d e f g h i) = a*e*i - a*f*h - b*d*i + b*f*g + c*d*h - c*e*g  -- | Transpose a matrix.-transpose :: Matrix3'3 a -> Matrix3'3 a+--+transpose :: Matrix3'3 u -> Matrix3'3 u transpose (M3'3 a b c                  d e f                  g h i) = M3'3 a d g  @@ -632,23 +669,23 @@  -- Helpers -adjoint :: Num a => Matrix3'3 a -> Matrix3'3 a +adjoint :: Num u => Matrix3'3 u -> Matrix3'3 u adjoint = transpose . cofactor . mofm  -cofactor :: Num a => Matrix3'3 a -> Matrix3'3 a+cofactor :: Num u => Matrix3'3 u -> Matrix3'3 u cofactor (M3'3 a b c                  d e f                  g h i) = M3'3   a  (-b)   c                              (-d)   e  (-f)                                g  (-h)   i -mofm :: Num a => Matrix3'3 a -> Matrix3'3 a+mofm :: Num u => Matrix3'3 u -> Matrix3'3 u mofm (M3'3 a b c                  d e f                  g h i)  = M3'3 m11 m12 m13                                 m21 m22 m23 -                          m31 m32 m33+                              m31 m32 m33   where       m11 = (e*i) - (f*h)     m12 = (d*i) - (f*g)@@ -726,5 +763,27 @@     p1    = p0 .+^ avec (ang1 + pi/2) e     p2    = p3 .+^ avec (ang2 - pi/2) e     p3    = pt .+^ avec ang2 r+++-- | Make a circle from Bezier curves - @n@ is the number of +-- subdivsions per quadrant.+--+bezierCircle :: (Fractional u, Floating u) +             => Int -> u -> Point2 u -> [Point2 u]+bezierCircle n radius pt = start $ subdivisions (n*4) (2*pi)+  where+    start (a:b:xs) = s : cp1 : cp2 : e : rest (b:xs)+      where (s,cp1,cp2,e) = bezierArc radius a b pt+                     +    start _        = [] ++    rest (a:b:xs)  = cp1 : cp2 : e : rest (b:xs)+      where (_,cp1,cp2,e) = bezierArc radius a b pt ++    rest _         = [] ++    subdivisions i a = 0 : take i (iterate (+one) one) +      where  one  = a / fromIntegral i+  

@@ -0,0 +1,139 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module      :  Wumpus.Core.OneList+-- Copyright   :  (c) Stephen Tetley 2010+-- License     :  BSD3+--+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>+-- Stability   :  highly unstable+-- Portability :  GHC+--+-- Data type for non-empty lists.+-- +-- Structurally the same as OneMany - but used for a different+-- purpose.+--+--------------------------------------------------------------------------------++module Wumpus.Core.OneList+  (+   -- OneMany+    OneList+  , ViewOL(..)++  , one+  , cons+  , head+  , viewl++  , fromList++  , toListF+  , accumMapL+  , isOne+  , isMany+   +  ) where+++import Data.Semigroup           -- package: algebra++import Control.Applicative+import Data.Foldable+import Data.Monoid+import Data.Traversable++import Prelude hiding ( head )++-- type OneMany a = OneList a++data OneList a = One a | Many a (OneList a)+  deriving (Eq)++data ViewOL a = OneL a | a :<< (OneList a)+  deriving (Eq)++--------------------------------------------------------------------------------+-- Instances++instance Show a => Show (OneList a) where+  show = ('{':) . ($ []) . step where+     step (One a)     = shows a . showChar '}'+     step (Many a as) = shows a . showChar ',' . step as+++instance Functor OneList where+  fmap f (One a)        = One $ f a+  fmap f (Many a as)    = Many (f a) (fmap f as)++instance Foldable OneList where+  foldMap f (One a)     = f a+  foldMap f (Many a as) = f a `mappend` foldMap f as++  foldr f b0 = step b0 where+    step b (One a)      = f a b+    step b (Many a as)  = f a (step b as)++  foldl f b0 = step b0 where+    step b (One a)      = f b a+    step b (Many a as)  = step (f b a) as+++instance Traversable OneList where+  traverse f (One a)      = One  <$> f a+  traverse f (Many a as)  = Many <$> f a <*> traverse f as+++instance Semigroup (OneList e) where+  (One a)     `append` bs  = Many a bs+  (Many a as) `append` bs  = Many a (as `append` bs)++--------------------------------------------------------------------------------+-- | Construct One.+one :: a -> OneList a+one = One+++-- | Prepend an element. Obviously this transforms a One to a Many.+cons :: a -> OneList a -> OneList a+cons a as   = Many a as++-- | 'head' is total of course.+head :: OneList a -> a+head (One a)    = a+head (Many a _) = a++viewl :: OneList a -> ViewOL a+viewl (One a)     = OneL a+viewl (Many a as) = a :<< as++-- | Construct Many. Not this function throws a error if the list has+-- zero or one elements+fromList :: [a] -> OneList a+fromList []     = error "OneList.fromList: cannot build Many from empty list"+fromList [a]    = One a+fromList (a:as) = Many a (fromList as)+++toListF :: (a -> b) -> OneList a -> [b]+toListF f = step where+  step (One x)     = [f x]+  step (Many x xs) = f x : step xs+++accumMapL :: (x -> st -> (y,st)) -> OneList x -> st -> (OneList y,st)+accumMapL f (One x)     st = let (y,st') = f x st in (One y,st')+accumMapL f (Many x xs) st = (Many y ys,st'')+                             where (y, st')  = f x st+                                   (ys,st'') = accumMapL f xs st'++isMany :: OneList a -> Bool+isMany (Many _ _) = True+isMany _          = False++isOne :: OneList a -> Bool+isOne (One _)     = True+isOne _           = False+

@@ -41,6 +41,7 @@  import MonadLib hiding ( Label ) +import qualified Data.Foldable as F   @@ -167,8 +168,8 @@ outputPicture (PicBlank  _)             = return () outputPicture (Single (fr,_) prim)      =      updateFrame fr $ outputPrimitive prim-outputPicture (Picture (fr,_) ones)      = do-    updateFrame fr $ onesmapM_ outputPicture  ones+outputPicture (Picture (fr,_) ones)     =+    updateFrame fr $ F.foldrM (\p _ -> outputPicture p) () ones outputPicture (Clip (fr,_) cp p)        =      updateFrame fr $ do { clipPath cp ; outputPicture p } 

@@ -55,6 +55,7 @@  import Text.XML.Light +import qualified Data.Foldable as F  type Clipped    = Bool @@ -107,9 +108,12 @@     return $ gElement (maybe [] return $ frameChange fr) [elt]  picture c (Picture (fr,_) ones)    = do-    es <- toListWithM (picture c) ones+    -- Note - list in zorder, so we want to draw the tail first +    es <- liftM toListH $ F.foldrM fn emptyH ones     return $ gElement (maybe [] return $ frameChange fr) es-+  where+    fn e hl = picture c e >>= \a -> return $ hl `snocH` a+   picture _ (Clip (fr,_) p a) = do     cp <- clipPath p    e1 <- picture True a

@@ -33,6 +33,8 @@   , vertexPath     , curvedPath +  , wumpus_default_font+   -- * Constructing primitives   , Stroke(..)   , zostroke@@ -67,9 +69,9 @@ import Wumpus.Core.Colour import Wumpus.Core.Geometry import Wumpus.Core.GraphicsState+import Wumpus.Core.OneList import Wumpus.Core.PictureInternal import Wumpus.Core.TextEncodingInternal-import Wumpus.Core.Utils  import Data.Semigroup @@ -128,6 +130,9 @@ -- | Lift a list of primitives to a composite picture, all  -- primitives will be located within the standard frame. --+-- The order of the list maps to the zorder - the front of the+-- list is drawn at the top.+-- -- This function throws an error when supplied the empty list. -- frameMulti :: (Fractional u, Floating u, Ord u) @@ -141,12 +146,14 @@ -- This function throws an error when supplied the empty list. -- multi :: (Fractional u, Ord u) => [Picture u] -> Picture u-multi ps = Picture (stdFrame, sconcat $ map boundary ps) ones+multi ps = Picture (stdFrame, sconcat $ map boundary ps) $ step ps   where      sconcat []      = error err_msg     sconcat (x:xs)  = foldr append x xs -    ones            = fromListErr ps err_msg+    step [x]        = one x+    step (x:xs)     = x `cons` step xs+    step _          = error err_msg      err_msg         = "Wumpus.Core.Picture.multi - empty list" @@ -192,7 +199,19 @@     +-- | Constant for the default font, which is @Courier@ (aliased +-- to @Courier New@ for SVG).+-- +-- The font size is 24 point. Note that only a handful of font +-- sizes are available directly to PostScript / GhostScript.+--+-- To get non-standard sizes, consider drawing the text and +-- applying a 'uniformScale'.+--+wumpus_default_font :: FontAttr+wumpus_default_font = FontAttr "Courier" "Courier New" SVG_REGULAR 24 + -------------------------------------------------------------------------------- -- Take Paths to Primitives @@ -322,11 +341,7 @@   where     lbl = Label pt (lexLabel txt) identityMatrix --- SVG seems to have an issue with /Courier/ and needs /Courier New/. -default_font :: FontAttr-default_font = FontAttr "Courier" "Courier New" SVG_REGULAR 24- -- | Create a text label. The string should not contain newline -- or tab characters. Use 'multilabel' to create text with  -- multiple lines.@@ -343,16 +358,17 @@   textlabel :: Num u => t -> String -> Point2 u -> Primitive u  -instance TextLabel () where textlabel () = mkTextLabel psBlack default_font+instance TextLabel () where +    textlabel () = mkTextLabel psBlack wumpus_default_font  instance TextLabel (RGB3 Double) where-  textlabel c = mkTextLabel (psColour c) default_font+  textlabel c = mkTextLabel (psColour c) wumpus_default_font  instance TextLabel (HSB3 Double) where-  textlabel c = mkTextLabel (psColour c) default_font+  textlabel c = mkTextLabel (psColour c) wumpus_default_font  instance TextLabel (Gray Double) where-  textlabel c = mkTextLabel (psColour c) default_font+  textlabel c = mkTextLabel (psColour c) wumpus_default_font  instance TextLabel FontAttr where   textlabel a = mkTextLabel psBlack a@@ -369,7 +385,7 @@ -- | Create a label where the font is @Courier@, text size is 24pt -- and colour is black. ztextlabel :: Num u => String -> Point2 u -> Primitive u-ztextlabel = mkTextLabel psBlack default_font+ztextlabel = mkTextLabel psBlack wumpus_default_font   @@ -385,7 +401,7 @@   -- | Create an ellipse, the ellipse will be filled unless the --- supplied attributes /imply/ a stoked ellipse, e.g.:+-- supplied attributes /imply/ a stroked ellipse, e.g.: -- -- > ellipse (LineWidth 4) zeroPt 40 40  --@@ -491,7 +507,7 @@ -- neither picture will be moved. -- picOver :: (Num u, Ord u) => Picture u -> Picture u -> Picture u-a `picOver` b = Picture (ortho zeroPt, bb) (mkList2 b a) +a `picOver` b = Picture (ortho zeroPt, bb) (cons b $ one a)    where     bb = union (boundary a) (boundary b) 

@@ -59,6 +59,7 @@ import Wumpus.Core.FontSize import Wumpus.Core.Geometry import Wumpus.Core.GraphicsState+import Wumpus.Core.OneList import Wumpus.Core.TextEncodingInternal import Wumpus.Core.Utils @@ -234,12 +235,12 @@ instance (Num u, Pretty u) => Pretty (Picture u) where   pretty (PicBlank m)       = text "*BLANK*" <+> ppLocale m   pretty (Single m prim)    = ppLocale m <$> indent 2 (pretty prim)-  pretty (Picture m ones)  = -      ppLocale m <$> indent 2 (list $ toListWith pretty ones)+  pretty (Picture m ones)   = +      ppLocale m <$> indent 2 (list $ toListF pretty ones)    pretty (Clip m cpath p)   =        text "Clip:" <+> ppLocale m <$> indent 2 (pretty cpath)-                                   <$> indent 2 (pretty p)+                                  <$> indent 2 (pretty p)  ppLocale :: (Num u, Pretty u) => Locale u -> Doc ppLocale (fr,bb) = align (ppfr <$> pretty bb) where@@ -303,7 +304,10 @@ type instance DUnit (Path u)        = u type instance DUnit (PrimEllipse u) = u +instance (Num u, Ord u) => Transform (Picture u) where+  transform ctm pic = transformPicture (transform ctm) (transform ctm) pic + instance (Floating u, Real u) => Rotate (Picture u) where   rotate = rotatePicture  @@ -316,6 +320,18 @@ instance (Num u, Ord u) => Translate (Picture u) where   translate = translatePicture ++-- Primitives++instance Num u => Transform (Primitive u) where+  transform ctm (PPath   attr path) = +      PPath attr $ transformPath (transform ctm) path++  transform ctm (PLabel   attr lbl) = PLabel attr $ transformLabel ctm lbl++  transform ctm (PEllipse attr ell) = PEllipse attr $ transformEllipse ctm ell++ instance (Real u, Floating u) => Rotate (Primitive u) where   rotate ang (PPath    attr path) = PPath    attr $ rotatePath ang path   rotate ang (PLabel   attr lbl)  = PLabel   attr $ rotateLabel ang lbl@@ -361,7 +377,11 @@ translatePicture :: (Num u, Ord u) => u -> u -> Picture u -> Picture u translatePicture x y = transformPicture (translate x y) (translate x y) -+-- TODO - the nameing for these functions is confusing now that+-- I've added a Transform typeclass.+--+-- Look to unifying the naming scheme in someway.+-- transformPicture :: (Num u, Ord u)                   => (Point2 u -> Point2 u)                   -> (Vec2 u -> Vec2 u) @@ -417,6 +437,9 @@  -- Labels +transformLabel :: Num u => Matrix3'3 u -> Label u -> Label u+transformLabel m33 (Label pt txt ctm) = Label pt txt (ctm * m33)+ -- rotate CTM and pt or just CTM ?? rotateLabel :: (Real u, Floating u) => Radian -> Label u -> Label u rotateLabel ang (Label pt txt ctm) = Label pt txt (ctm * rotationMatrix ang)@@ -437,6 +460,10 @@  --  +transformEllipse :: Num u => Matrix3'3 u -> PrimEllipse u -> PrimEllipse u+transformEllipse m33 (PrimEllipse pt hw hh ctm) = +    PrimEllipse pt hw hh (ctm * m33)+ rotateEllipse :: (Real u, Floating u)                => Radian -> PrimEllipse u -> PrimEllipse u rotateEllipse ang (PrimEllipse pt hw hh ctm) = @@ -569,19 +596,14 @@ -- ellipseControlPoints :: (Floating u, Ord u)                      => PrimEllipse u -> [Point2 u]-ellipseControlPoints (PrimEllipse ctr hw hh ctm) = -    map (new_mtrx *#) $ start circ+ellipseControlPoints (PrimEllipse ctr hw hh ctm) = map (new_mtrx *#) circ   where     (radius,(dx,dy)) = circleScalingProps hw hh     new_mtrx         = ctm * scalingMatrix dx dy-    circ             = bezierCircle radius ctr-    -    start ((a,b,c,d):xs)  = a:b:c:d : rest xs-    start _               = []      -- should be unreachable-    -    rest  ((_,b,c,d):xs)  = b:c:d : rest xs-    rest  _               = []+    circ             = bezierCircle 1 radius ctr +    -- subdivide the bezierCircle with 1 to get two+    -- control points per quadrant.       --@@ -598,16 +620,5 @@     (dx,dy)    = if radius == hw then (1, rescale (0,hw) (0,1) hh)                                  else (rescale (0,hh) (0,1) hw, 1) ----- | Make a circle from Bezier curves - @n@ is the number of --- subdivsions per quadrant.----bezierCircle :: Floating u -             => u -> Point2 u -> [(Point2 u, Point2 u, Point2 u, Point2 u)]-bezierCircle radius pt = map mkQuad angs-  where-    angs         = [(0, pi*0.5), (pi*0.5,pi), (pi, pi*1.5), (pi*1.5, pi*2)]-    mkQuad (a,b) = bezierArc radius a b pt  

@@ -19,12 +19,9 @@ module Wumpus.Core.Utils   (  -  -- * Component-wise min and max-    CMinMax(..)-  , within    -- * Three values  -  , max3+    max3   , min3   , med3 @@ -55,16 +52,9 @@    -- * Hughes list   , H+  , emptyH   , toListH-  --  -- * OneList type - non-empty list type-  , OneList(..)-  , mkList2-  , onesmapM_-  , toListWith-  , toListWithM-  , fromListErr+  , snocH       -- * specs etc. from Data.Aviary@@ -80,7 +70,6 @@   import Control.Applicative-import Control.Monad ( ap ) import Data.List ( intersperse ) import Data.Ratio import Data.Time@@ -89,35 +78,7 @@  -------------------------------------------------------------------------------- --- | /Component-wise/ min and max. --- Standard 'min' and 'max' via Ord are defined lexographically--- on pairs, e.g.:--- --- > min (1,2) (2,1) = (1,2)--- --- For certain geometrical objects (Points!) we want the --- (constructed-) componentwise min and max, e.g:------ > cmin (1,2) (2,1) = (1,1) --- > cmax (1,2) (2,1) = (2,2)---  -class CMinMax a where-  cmin :: a -> a -> a-  cmax :: a -> a -> a----instance (Ord a, Ord b) => CMinMax (a,b) where-  cmin (x,y) (x',y') = (min x x', min y y')-  cmax (x,y) (x',y') = (max x x', max y y')----- | Test whether a is within opper and lower.-within :: Eq a => CMinMax a => a -> a -> a -> Bool-within a lower upper = (cmin a lower) == lower && (cmax a upper) == upper-- -- | max of 3 max3 :: Ord a => a -> a -> a -> a max3 a b c = max (max a b) c@@ -265,52 +226,16 @@  type H a = [a] -> [a] +emptyH :: H a+emptyH = id+ toListH :: H a -> [a] toListH = ($ []) -----------------------------------------------------------------------------------infixr 5 `Many`--data OneList a = One a | Many a  (OneList a)-  deriving (Eq)--instance Show a => Show (OneList a) where-  show = ('{':) . ($ []) . step where-     step (One a)     = shows a . showChar '}'-     step (Many a xs) = shows a . showChar ',' . step xs---mkList2 :: a -> a -> OneList a-mkList2 a b = a `Many` One b---onesmapM_ :: Monad m => (a -> m b) -> OneList a -> m ()-onesmapM_ f (One x)     = f x >> return ()-onesmapM_ f (Many x xs) = f x >> onesmapM_ f xs--toListWith :: (a -> b) -> OneList a -> [b]-toListWith f (One x)     = [f x]-toListWith f (Many x xs) = f x : toListWith f xs--toListWithM :: Monad m => (a -> m b) -> OneList a -> m [b]-toListWithM mf (One x)     = mf x >>= \a -> return [a]-toListWithM mf (Many x xs) = return (:) `ap` mf x `ap` toListWithM mf xs----- Error msg is a parameter, so client code can supply a --- meaningful warning.--- -fromListErr :: [a] -> String -> OneList a-fromListErr xs0 msg = step xs0 where-   step []     = error msg-   step [a]    = One a-   step (a:xs) = Many a $ step xs--+snocH :: H a -> a -> H a+snocH hl a = hl . (a:)  ---------------------------------------------------------------------------------  -- | A variant of the @D2@ or dovekie combinator - the argument -- order has been changed to be more satisfying for Haskellers:

@@ -22,4 +22,4 @@   wumpus_core_version :: (Int,Int,Int)-wumpus_core_version = (0,18,0)+wumpus_core_version = (0,19,0)

@@ -172,7 +172,7 @@ import Wumpus.Core.Colour ( RGB3(..), DRGB )  -import Prelude hiding ( tan )+import Prelude ( )     

@@ -1,5 +1,5 @@ name:             wumpus-core-version:          0.18.0+version:          0.19.0 license:          BSD3 license-file:     LICENSE copyright:        Stephen Tetley <stephen.tetley@gmail.com>@@ -16,7 +16,7 @@   It can generate PostScript (EPS) files and SVG files. The    generated PostScript code is plain [1] and reasonably    efficient as the use of stack operations, i.e @gsave@ and -  @grestore@ is minimized.+  @grestore@, is minimized.   .   Pictures in Wumpus are made from /paths/ and text /labels/.    Paths themselves are made from points. The usual affine @@ -25,35 +25,34 @@   is no notion of a current point, Wumpus builds pictures in a   coordinate-free style.    .-  With recent revisions, I\'ve added some extra helper modules-  that are not really part of the \"core\", but they provide -  lists of named colours and /safe/ fonts, plus some code  -  (Extra.PictureLanguage) that has been moved out of the-  wumpus-core namespace because it is somewhat \"higher-level\". +  Wumpus-core includes some extra helper modules that are not +  really part of the \"core\", but are otherwise currently +  homeless. They provide lists of named colours and /safe/ +  fonts, plus some prototype code (Extra.PictureLanguage) for +  arranging pictures.   .   WARNING...   .-  With revision 0.18.0, I\'ve changed the internals a bit so that -  Primitives (paths, text labels) support affine transformations. -  In the end, this didn\'t changed the API significantly, though -  with the next revision, I want to look at changing the -  PostScript output - swapping some uses of @concat@ to @moveto@; -  so again there is the possibility of significant changes -  between this revision and the next one.+  The modules @Core.BoundingBox@ and @Extra.PictureLanguage@ are+  likely to be reworked significantly in the future.    .-  Also the module, Core.BoundingBox, is still a candidate for -  reworking, as it has too many functions that do not offer +  @Core.BoundingBox@ has too many functions that do not offer    distinct functionality. Some functions were removed in    revision 0.17.0 and some more are likely to follow.    .+  @Extra.PictureLanguage@ needs some more thought. The current +  set of classes is rather cumbersome, and some of the operations +  would benefit new names.+  .   NOTE...   .-  One consequence of adding affine transformations for primitives-  is that the bounding box of a primitive under transformation -  may be tighter than than the bounding box of transformed -  picture containing the same primitive, i.e.:+  Revision 0.17.0 added affine transformations for primitives +  (paths, text labels, ellipses), one consequence of this is +  the bounding box may be tighter for a primitive under affine +  transformation then lifted to a picture, than a primitive +  lifted to picture then transformed, i.e.:   . -  @liftToPicture (transform PRIM) /= transform (liftToPicture PRIM)@+  @boundary (liftToPicture (transform PRIM)) /= boundary (transform (liftToPicture PRIM))@   .   Where liftToPicture is usually @frame@ from    @Wumpus.Core.Picture@.@@ -72,22 +71,52 @@   found at <http://code.google.com/p/copperbox/> though.   .   Some of the design decisions made for wumpus-core are not -  sophisticated (e.g. how attributes like colour are -  handled, and how the bounding boxes of text labels are -  calculated), so Wumpus might be limited compared to other -  systems. However, the design permits a simple implementation - -  which is a priority. Text encoding an exception - I\'m not -  sure how reasonable the design is. The current implementation +  sophisticated (e.g. how attributes like colour are handled, +  and how the bounding boxes of text labels are calculated), so +  Wumpus might be limited compared to other systems. However, +  the design permits a fairly simple implementation - which is +  a priority. Text encoding an exception - I\'m not sure how +  reasonable the design is. The current implementation    appears okay for Latin 1 but may be inadequate for other    character sets, so I may have to revise it significantly.   .   .   \[1\] Because the output is simple, straight-line PostScript -  code, it is possible to use GraphicsMagick or a similar tool to -  convert Wumpus'\s EPS files to many other formats (bitmaps). +  code, it is possible to use GraphicsMagick or a similar tool +  to convert Wumpus'\s EPS files to many other formats +  (bitmaps).    .   Changelog:   .+  0.18,0 to 0.19.0:+  .+  * Added @Transform@ type class to apply a matrix transformation+    directly.+  .+  * Changed the ordering of picture drawing in PostScript and SVG+    output so the list gets drawn from tail to head with right +    folds. This makes the list order of pictures match their +    zorder.+  .+  * Renamed the function @withinBB@ (Core.BoundingBox) to +    @within@.+  .+  * On many type signatures with e.g. Points, I\'ve changed the +    parameter name on the type constructor from @a@ to @u@.+    This is to indicate that @u@ is some unit - almost always a+    Double. e.g @Point2 a@ becomes @Point2 u@ and all the class+    obligations change lexically as well @Floating a =>@ to +    @Floating u =>@. Superficially this means a lot of type +    signatures have diffs but haven\'t really changed. +  .+  * Added function @bezierCircle@ to generate the Bezier curve +    points for arcs describing a circle.+  .+  * Added new demo - MultiPic. The PostScript it generates+    is efficient - no extraneous use of @concat@. +  .+  * Added wumpus_default_font constant.+  .   0.17.0 to 0.18.0:   .   * Added instances of the affine operation classes (Scale, @@ -105,7 +134,7 @@     transformation, Pictures may generate a larger bounding box      than composite primitives.   .-  * Minor change - ztextlabal changed to use 24pt type rather +  * Minor change - ztextlabel changed to use 24pt type rather      than 12pt.    .   * Corrected the cabal file to include the correct files for @@ -113,54 +142,7 @@     missing with the generated file @WorldFrame.eps@ incorrectly      included instead.   .-  0.16.0 to 0.17.0:   .-  * Added Core.WumpusTypes to export opaque versions of-    datatypes from Core.PictureInternal. This should make-    the Haddock documentation more cohesive.-  . -  * Moved the Core.PictureLanguage module into the Extra-    namespace (Extra.PictureLanguage). This module may change-    in detail, if not in spirit in the future as I'm not -    very happy with it. Also this module is somewhat -    \"higher-level\" than the modules in wumpus-core, so -    a different home seems fitting. -  . -  * Removed CardinalPoint and boundaryPoint from BoundingBox.-  .-  * Argument order of 'textlabel' and 'ztextlabel' changed so-    that Point2 is the last argument.-  .-  * PathSegment constructor names changed - this is an internal-    change as the constructors are not exported.-  .-  * Primitive type changed - moved Ellipse properties into -    PrimEllipse type - internal change.-  .-  * Removed dependency on \'old-time\'.-  .-  0.15.0 to 0.16.0:-  .-  * Additions to Core.Geometry (direction, pvec, vangle, -    circularModulo).-  .-  * Fixed error with langle due to not accounting for circle -    quadrants in Core.Geometry.-  .-  * Point2 now derives Ord - so it can be used as a key for-    Data.Map.-  .-  * Added escape-character handling to text output in PostScript.-    This was causing a nasty bug where a drawing would completely-    fail when special chars shown (GhostView gives little hint of -    what is wrong when such errors are present).-  . -  * Changed BoundingBox operation 'corners' to return a 4-tuple-    rather than a list.-  .  -  * Added centeredAt to PictureLanguage-  .-  . build-type:         Simple stability:          unstable cabal-version:      >= 1.2@@ -175,6 +157,7 @@   demo/AffineTestBase.hs,   demo/FontPic.hs,   demo/LabelPic.hs,+  demo/MultiPic.hs   demo/Picture.hs,   doc/Guide.pdf,   doc-src/Guide.lhs,@@ -214,6 +197,7 @@     Wumpus.Core.PictureInternal,     Wumpus.Core.PostScript,     Wumpus.Core.SVG,+    Wumpus.Core.OneList,     Wumpus.Core.TextEncodingInternal,     Wumpus.Core.Utils