diff --git a/CHANGES b/CHANGES
--- a/CHANGES
+++ b/CHANGES
@@ -1,10 +1,39 @@
+
+0.20.0 to 0.21.0:
+
+ * Removed the instances of the Affine transformation. They have
+ been replaced with special transformation functions:
+ @rotatePrimitive@, @scalePrimitive@, @translatePrimitive@.
+ As Primitives are not in an affine frame until they are lifted
+ to Pictures the affine instances had ill-conceived semantics.
+
+ * Due to changes to accommodate the new non-affine
+ transformations, many of the class obligations have changed
+ on the @unit@ of Pictures, Primitives, Bounding Boxes etc.
+ Generally many class contexts that previously required
+ Fractional and Ord on the unit have changed to Real and
+ Floating.
+
+ * Removed demo/AffineTest04.hs - there is no longer a
+ @rotateAbout@ operation on Primitives as they do not exist
+ in an affine frame until they they are lifted to Pictures.
+ Added - Scaled.hs, Rotated.hs, Translated,hs.
+
+ * Removed the UndecidableInstances pragma from
+ Core.PictureInternal. It looks like Core.Geometry will always
+ needs UndecidableInstances though.
+
+ * Removed the Ord superclass constriant from the @Stroke@ and
+ @Fill@ classes and derived operations (e.g. @zostroke@).
+
+
0.19.0 to 0.20.0:
* Removed the modules:
(1) Wumpus.Extra.SafeFonts
(2) Wumpus.Extra.SVGColours@
- (3) Wumpus.Extra.X11Colours - they are now in the package
- @wumpus-basic@.
+ (3) Wumpus.Extra.X11Colours
+ - they are now in the package @wumpus-basic@.
* Removed the example FontPic.hs to @wumpus-basic@.
diff --git a/demo/AffineTest01.hs b/demo/AffineTest01.hs
--- a/demo/AffineTest01.hs
+++ b/demo/AffineTest01.hs
@@ -20,6 +20,9 @@
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))
+
-- Primitive - Text
@@ -30,7 +33,7 @@
, ata_svg_file = "./out/affine_test/rotate_text.svg"
, ata_prim_constructor = rgbLabel
, ata_pic_transformer = rot30
- , ata_prim_transformer = rot30
+ , ata_prim_transformer = rot30P
}
circle_ata :: AffineTrafoAlg
@@ -40,7 +43,7 @@
, ata_svg_file = "./out/affine_test/rotate_circle.svg"
, ata_prim_constructor = rgbCircle
, ata_pic_transformer = rot30
- , ata_prim_transformer = rot30
+ , ata_prim_transformer = rot30P
}
@@ -51,7 +54,7 @@
, ata_svg_file = "./out/affine_test/rotate_ellipse.svg"
, ata_prim_constructor = rgbEllipse
, ata_pic_transformer = rot30
- , ata_prim_transformer = rot30
+ , ata_prim_transformer = rot30P
}
path_ata :: AffineTrafoAlg
@@ -61,7 +64,7 @@
, ata_svg_file = "./out/affine_test/rotate_path.svg"
, ata_prim_constructor = rgbPath
, ata_pic_transformer = rot30
- , ata_prim_transformer = rot30
+ , ata_prim_transformer = rot30P
}
@@ -74,7 +77,7 @@
, cpa_eps_file = "./out/affine_test/rotate_crc_cp.eps"
, cpa_svg_file = "./out/affine_test/rotate_crc_cp.svg"
, cpa_prim_constructor = rgbCircle
- , cpa_prim_transformer = rot30
+ , cpa_prim_transformer = rot30P
}
@@ -85,7 +88,7 @@
, cpa_eps_file = "./out/affine_test/rotate_ell_cp.eps"
, cpa_svg_file = "./out/affine_test/rotate_ell_cp.svg"
, cpa_prim_constructor = rgbEllipse
- , cpa_prim_transformer = rot30
+ , cpa_prim_transformer = rot30P
}
@@ -95,6 +98,6 @@
, cpa_eps_file = "./out/affine_test/rotate_path_cp.eps"
, cpa_svg_file = "./out/affine_test/rotate_path_cp.svg"
, cpa_prim_constructor = rgbPath
- , cpa_prim_transformer = rot30
+ , cpa_prim_transformer = rot30P
}
diff --git a/demo/AffineTest02.hs b/demo/AffineTest02.hs
--- a/demo/AffineTest02.hs
+++ b/demo/AffineTest02.hs
@@ -19,6 +19,10 @@
scale_onehalf_x_two :: (Scale t, Fractional u, u ~ DUnit t) => t -> t
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
+
-- Primitive - Text
@@ -29,7 +33,7 @@
, ata_svg_file = "./out/affine_test/scale_text.svg"
, ata_prim_constructor = rgbLabel
, ata_pic_transformer = scale_onehalf_x_two
- , ata_prim_transformer = scale_onehalf_x_two
+ , ata_prim_transformer = scale_onehalf_x_twoP
}
circle_ata :: AffineTrafoAlg
@@ -39,7 +43,7 @@
, ata_svg_file = "./out/affine_test/scale_circle.svg"
, ata_prim_constructor = rgbCircle
, ata_pic_transformer = scale_onehalf_x_two
- , ata_prim_transformer = scale_onehalf_x_two
+ , ata_prim_transformer = scale_onehalf_x_twoP
}
@@ -50,7 +54,7 @@
, ata_svg_file = "./out/affine_test/scale_ellipse.svg"
, ata_prim_constructor = rgbEllipse
, ata_pic_transformer = scale_onehalf_x_two
- , ata_prim_transformer = scale_onehalf_x_two
+ , ata_prim_transformer = scale_onehalf_x_twoP
}
path_ata :: AffineTrafoAlg
@@ -60,7 +64,7 @@
, ata_svg_file = "./out/affine_test/scale_path.svg"
, ata_prim_constructor = rgbPath
, ata_pic_transformer = scale_onehalf_x_two
- , ata_prim_transformer = scale_onehalf_x_two
+ , ata_prim_transformer = scale_onehalf_x_twoP
}
@@ -73,7 +77,7 @@
, cpa_eps_file = "./out/affine_test/scale_crc_cp.eps"
, cpa_svg_file = "./out/affine_test/scale_crc_cp.svg"
, cpa_prim_constructor = rgbCircle
- , cpa_prim_transformer = scale_onehalf_x_two
+ , cpa_prim_transformer = scale_onehalf_x_twoP
}
@@ -84,7 +88,7 @@
, cpa_eps_file = "./out/affine_test/scale_ell_cp.eps"
, cpa_svg_file = "./out/affine_test/scale_ell_cp.svg"
, cpa_prim_constructor = rgbEllipse
- , cpa_prim_transformer = scale_onehalf_x_two
+ , cpa_prim_transformer = scale_onehalf_x_twoP
}
@@ -94,6 +98,6 @@
, cpa_eps_file = "./out/affine_test/scale_path_cp.eps"
, cpa_svg_file = "./out/affine_test/scale_path_cp.svg"
, cpa_prim_constructor = rgbPath
- , cpa_prim_transformer = scale_onehalf_x_two
+ , cpa_prim_transformer = scale_onehalf_x_twoP
}
diff --git a/demo/AffineTest03.hs b/demo/AffineTest03.hs
--- a/demo/AffineTest03.hs
+++ b/demo/AffineTest03.hs
@@ -19,6 +19,9 @@
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
+
-- Primitive - Text
@@ -29,7 +32,7 @@
, ata_svg_file = "./out/affine_test/trans_text.svg"
, ata_prim_constructor = rgbLabel
, ata_pic_transformer = translate_20x40
- , ata_prim_transformer = translate_20x40
+ , ata_prim_transformer = translate_20x40P
}
circle_ata :: AffineTrafoAlg
@@ -39,7 +42,7 @@
, ata_svg_file = "./out/affine_test/trans_circle.svg"
, ata_prim_constructor = rgbCircle
, ata_pic_transformer = translate_20x40
- , ata_prim_transformer = translate_20x40
+ , ata_prim_transformer = translate_20x40P
}
@@ -50,7 +53,7 @@
, ata_svg_file = "./out/affine_test/trans_ellipse.svg"
, ata_prim_constructor = rgbEllipse
, ata_pic_transformer = translate_20x40
- , ata_prim_transformer = translate_20x40
+ , ata_prim_transformer = translate_20x40P
}
path_ata :: AffineTrafoAlg
@@ -60,7 +63,7 @@
, ata_svg_file = "./out/affine_test/trans_path.svg"
, ata_prim_constructor = rgbPath
, ata_pic_transformer = translate_20x40
- , ata_prim_transformer = translate_20x40
+ , ata_prim_transformer = translate_20x40P
}
@@ -73,7 +76,7 @@
, cpa_eps_file = "./out/affine_test/trans_crc_cp.eps"
, cpa_svg_file = "./out/affine_test/trans_crc_cp.svg"
, cpa_prim_constructor = rgbCircle
- , cpa_prim_transformer = translate_20x40
+ , cpa_prim_transformer = translate_20x40P
}
@@ -84,7 +87,7 @@
, cpa_eps_file = "./out/affine_test/trans_ell_cp.eps"
, cpa_svg_file = "./out/affine_test/trans_ell_cp.svg"
, cpa_prim_constructor = rgbEllipse
- , cpa_prim_transformer = translate_20x40
+ , cpa_prim_transformer = translate_20x40P
}
@@ -94,6 +97,6 @@
, cpa_eps_file = "./out/affine_test/trans_path_cp.eps"
, cpa_svg_file = "./out/affine_test/trans_path_cp.svg"
, cpa_prim_constructor = rgbPath
- , cpa_prim_transformer = translate_20x40
+ , cpa_prim_transformer = translate_20x40P
}
diff --git a/demo/AffineTest04.hs b/demo/AffineTest04.hs
deleted file mode 100644
--- a/demo/AffineTest04.hs
+++ /dev/null
@@ -1,99 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
-{-# OPTIONS -Wall #-}
-
---------------------------------------------------------------------------------
--- ROTATE_ABOUT tests
---------------------------------------------------------------------------------
-
-module AffineTest04 where
-
-
-import AffineTestBase
-import Wumpus.Core
-
-main :: IO ()
-main = runAlgs [ text_ata, circle_ata, ellipse_ata, path_ata ]
- [ circle_cpa, ellipse_cpa, path_cpa ]
-
-
-rot30_about_origin :: (RotateAbout t, Fractional u, u ~ DUnit t) => t -> t
-rot30_about_origin = rotate30About zeroPt
-
--- Primitive - Text
-
-
-text_ata :: AffineTrafoAlg
-text_ata = AffineTrafoAlg
- { ata_console_msg = "Rotation about point, text..."
- , ata_eps_file = "./out/affine_test/rotate_about_text.eps"
- , ata_svg_file = "./out/affine_test/rotate_about_text.svg"
- , ata_prim_constructor = rgbLabel
- , ata_pic_transformer = rot30_about_origin
- , ata_prim_transformer = rot30_about_origin
- }
-
-circle_ata :: AffineTrafoAlg
-circle_ata = AffineTrafoAlg
- { ata_console_msg = "Rotation about point, circle..."
- , ata_eps_file = "./out/affine_test/rotate_about_circle.eps"
- , ata_svg_file = "./out/affine_test/rotate_about_circle.svg"
- , ata_prim_constructor = rgbCircle
- , ata_pic_transformer = rot30_about_origin
- , ata_prim_transformer = rot30_about_origin
- }
-
-
-ellipse_ata :: AffineTrafoAlg
-ellipse_ata = AffineTrafoAlg
- { ata_console_msg = "Rotation about point, ellipse..."
- , ata_eps_file = "./out/affine_test/rotate_about_ellipse.eps"
- , ata_svg_file = "./out/affine_test/rotate_about_ellipse.svg"
- , ata_prim_constructor = rgbEllipse
- , ata_pic_transformer = rot30_about_origin
- , ata_prim_transformer = rot30_about_origin
- }
-
-path_ata :: AffineTrafoAlg
-path_ata = AffineTrafoAlg
- { ata_console_msg = "Rotation about point, path..."
- , ata_eps_file = "./out/affine_test/rotate_about_path.eps"
- , ata_svg_file = "./out/affine_test/rotate_about_path.svg"
- , ata_prim_constructor = rgbPath
- , ata_pic_transformer = rot30_about_origin
- , ata_prim_transformer = rot30_about_origin
- }
-
-
---------------------
---------------------
-
-circle_cpa :: ControlPointAlg
-circle_cpa = ControlPointAlg
- { cpa_console_msg = "Rotation about point, circle (control points) ..."
- , cpa_eps_file = "./out/affine_test/rotate_about_crc_cp.eps"
- , cpa_svg_file = "./out/affine_test/rotate_about_crc_cp.svg"
- , cpa_prim_constructor = rgbCircle
- , cpa_prim_transformer = rot30_about_origin
- }
-
-
-
-ellipse_cpa :: ControlPointAlg
-ellipse_cpa = ControlPointAlg
- { cpa_console_msg = "Rotation about point, ellipse (control points) ..."
- , cpa_eps_file = "./out/affine_test/rotate_about_ell_cp.eps"
- , cpa_svg_file = "./out/affine_test/rotate_about_ell_cp.svg"
- , cpa_prim_constructor = rgbEllipse
- , cpa_prim_transformer = rot30_about_origin
- }
-
-
-path_cpa :: ControlPointAlg
-path_cpa = ControlPointAlg
- { cpa_console_msg = "Rotation about point, path (control points)..."
- , cpa_eps_file = "./out/affine_test/rotate_about_path_cp.eps"
- , cpa_svg_file = "./out/affine_test/rotate_about_path_cp.svg"
- , cpa_prim_constructor = rgbPath
- , cpa_prim_transformer = rot30_about_origin
- }
-
diff --git a/demo/AffineTestBase.hs b/demo/AffineTestBase.hs
--- a/demo/AffineTestBase.hs
+++ b/demo/AffineTestBase.hs
@@ -132,9 +132,16 @@
emptyH :: H a
emptyH = id
-snocH :: H a -> a -> H a
-snocH hf a = hf . (a:)
+-- NOTE - this is redundant if we want consH
+-- rather than snocH.
+--
+-- Some of the drawings do appear to have problems with
+-- Z-order so we'll keep it for now.
+--
+consH :: a -> H a -> H a
+consH a hf = hf . (a:)
+
toListH :: H a -> [a]
toListH = ($ [])
@@ -156,11 +163,11 @@
infixl 6 `line_to`, `curve_to`
line_to :: HPath u -> (u,u) -> HPath u
-line_to (s,f) (x,y) = (s, f `snocH` lineTo (P2 x y))
+line_to (s,f) (x,y) = (s, lineTo (P2 x y) `consH` f)
curve_to :: HPath u -> ((u,u),(u,u),(u,u)) -> HPath u
curve_to (s,f) ((c1x,c1y),(c2x,c2y),(ex,ey)) =
- (s, f `snocH` curveTo (P2 c1x c1y) (P2 c2x c2y) (P2 ex ey))
+ (s, curveTo (P2 c1x c1y) (P2 c2x c2y) (P2 ex ey) `consH` f)
--
diff --git a/demo/LabelPic.hs b/demo/LabelPic.hs
--- a/demo/LabelPic.hs
+++ b/demo/LabelPic.hs
@@ -11,7 +11,7 @@
-drawBounds :: (Fractional u, Floating u, Ord u) => Picture u -> Picture u
+drawBounds :: (Floating u, Real u) => Picture u -> Picture u
drawBounds p = p `over` (frame $ cstroke () ph)
where
ph = vertexPath $ [bl,br,tr,tl]
diff --git a/demo/MultiPic.hs b/demo/MultiPic.hs
--- a/demo/MultiPic.hs
+++ b/demo/MultiPic.hs
@@ -7,10 +7,13 @@
import Data.AffineSpace
+import System.Directory
+
main :: IO ()
main = do
- writeEPS_latin1 "./out/multi_pic.eps" pic1
- writeSVG_latin1 "./out/multi_pic.svg" pic1
+ createDirectoryIfMissing True "./out/"
+ writeEPS_latin1 "./out/multi_pic.eps" pic1
+ writeSVG_latin1 "./out/multi_pic.svg" pic1
diff --git a/demo/Rotated.hs b/demo/Rotated.hs
new file mode 100644
--- /dev/null
+++ b/demo/Rotated.hs
@@ -0,0 +1,70 @@
+{-# OPTIONS -Wall #-}
+
+module Rotated where
+
+import Wumpus.Core
+import Wumpus.Core.Colour
+
+import Data.AffineSpace
+
+import System.Directory
+
+
+main :: IO ()
+main = do
+ createDirectoryIfMissing True "./out/"
+ writeEPS_latin1 "./out/rot_square.eps" pic1
+ writeSVG_latin1 "./out/rot_square.svg" pic1
+ writeEPS_latin1 "./out/rot_circle.eps" pic2
+ writeSVG_latin1 "./out/rot_circle.svg" pic2
+ writeEPS_latin1 "./out/rot_label.eps" pic3
+ writeSVG_latin1 "./out/rot_label.svg" pic3
+
+
+-- both squares should share the bottom left coord...
+
+deg45 :: Radian
+deg45 = d2r (45.0::Double)
+
+
+pic1 :: DPicture
+pic1 = illustrateBounds grey $ frameMulti $
+ [ rotatePrimitive deg45 $ square blue 50 (P2 100 100)
+ , square red 50 (P2 100 100)
+ ]
+
+
+
+-- both ellipses should share the same center
+pic2 :: DPicture
+pic2 = illustrateBounds grey $ frameMulti $
+ [ rotatePrimitive deg45 $ ellipseHH blue 25 (P2 100 100)
+ , ellipseHH red 25 (P2 100 100)
+ ]
+
+
+-- both labels should share the same bottom left corner
+pic3 :: DPicture
+pic3 = illustrateBounds grey $ frameMulti $
+ [ rotatePrimitive deg45 $ label blue (P2 100 100)
+ , label red (P2 100 100)
+ ]
+
+
+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]
+
+
+
+ellipseHH :: Fractional u => DRGB -> u -> Point2 u -> Primitive u
+ellipseHH rgb radius ctr = ellipse rgb radius (0.5*radius) ctr
+
+label :: Num u => DRGB -> Point2 u -> Primitive u
+label rgb bl = textlabel rgb "Wumpus" bl
+
+
+grey :: DRGB
+grey = iRGB3 176 197 223
+
+
diff --git a/demo/Scaled.hs b/demo/Scaled.hs
new file mode 100644
--- /dev/null
+++ b/demo/Scaled.hs
@@ -0,0 +1,63 @@
+{-# OPTIONS -Wall #-}
+
+module Scaled where
+
+import Wumpus.Core
+import Wumpus.Core.Colour
+
+import Data.AffineSpace
+
+import System.Directory
+
+main :: IO ()
+main = do
+ createDirectoryIfMissing True "./out/"
+ writeEPS_latin1 "./out/scaled_square.eps" pic1
+ writeSVG_latin1 "./out/scaled_square.svg" pic1
+ writeEPS_latin1 "./out/scaled_circle.eps" pic2
+ writeSVG_latin1 "./out/scaled_circle.svg" pic2
+ writeEPS_latin1 "./out/scaled_label.eps" pic3
+ writeSVG_latin1 "./out/scaled_label.svg" pic3
+
+
+-- both squares should share the bottom left corner
+
+pic1 :: DPicture
+pic1 = illustrateBounds grey $ frameMulti $
+ [ uniformScalePrimitive 0.5 $ square blue 50 (P2 100 100)
+ , square red 50 (P2 100 100)
+ ]
+
+
+-- both ellipses should share the same center
+pic2 :: DPicture
+pic2 = illustrateBounds grey $ frameMulti $
+ [ uniformScalePrimitive 0.5 $ ellipseHH blue 25 (P2 100 100)
+ , ellipseHH red 25 (P2 100 100)
+ ]
+
+
+-- both labels should share the same bottom left corner
+pic3 :: DPicture
+pic3 = illustrateBounds grey $ frameMulti $
+ [ uniformScalePrimitive 0.5 $ label blue (P2 100 100)
+ , label red (P2 100 100)
+ ]
+
+
+
+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]
+
+ellipseHH :: Fractional u => DRGB -> u -> Point2 u -> Primitive u
+ellipseHH rgb radius ctr = ellipse rgb radius (0.5*radius) ctr
+
+label :: Num u => DRGB -> Point2 u -> Primitive u
+label rgb bl = textlabel rgb "Wumpus" bl
+
+
+grey :: DRGB
+grey = iRGB3 176 197 223
+
+
diff --git a/demo/Translated.hs b/demo/Translated.hs
new file mode 100644
--- /dev/null
+++ b/demo/Translated.hs
@@ -0,0 +1,59 @@
+{-# OPTIONS -Wall #-}
+
+module Translated where
+
+import Wumpus.Core
+import Wumpus.Core.Colour
+
+import Data.AffineSpace
+
+import System.Directory
+
+main :: IO ()
+main = do
+ createDirectoryIfMissing True "./out/"
+ writeEPS_latin1 "./out/trans_square.eps" pic1
+ writeSVG_latin1 "./out/trans_square.svg" pic1
+ writeEPS_latin1 "./out/trans_circle.eps" pic2
+ writeSVG_latin1 "./out/trans_circle.svg" pic2
+ writeEPS_latin1 "./out/trans_label.eps" pic3
+ writeSVG_latin1 "./out/trans_label.svg" pic3
+
+
+-- both squares should share the bottom left coord...
+pic1 :: DPicture
+pic1 = illustrateBounds grey $ frameMulti $
+ [ translatePrimitive 100 10 $ square blue 50 (P2 100 100)
+ , square red 50 (P2 100 100)
+ ]
+
+pic2 :: DPicture
+pic2 = illustrateBounds grey $ frameMulti $
+ [ translatePrimitive 100 10 $ ellipseHH blue 25 (P2 100 100)
+ , ellipseHH red 25 (P2 100 100)
+ ]
+
+pic3 :: DPicture
+pic3 = illustrateBounds grey $ frameMulti $
+ [ translatePrimitive 100 10 $ label blue (P2 100 100)
+ , label red (P2 100 100)
+ ]
+
+
+
+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]
+
+ellipseHH :: Fractional u => DRGB -> u -> Point2 u -> Primitive u
+ellipseHH rgb radius ctr = ellipse rgb radius (0.5*radius) ctr
+
+label :: Num u => DRGB -> Point2 u -> Primitive u
+label rgb bl = textlabel rgb "Wumpus" bl
+
+
+grey :: DRGB
+grey = iRGB3 176 197 223
+
+
+
diff --git a/doc-src/Guide.lhs b/doc-src/Guide.lhs
--- a/doc-src/Guide.lhs
+++ b/doc-src/Guide.lhs
@@ -240,7 +240,13 @@
...
\end{verbatim}
-
+For efficiency reasons \wumpuscore supports some transformations
+on Primitives. These are not affine transformations as Primitives
+are not in an affine frame until they are lifted to Pictures.
+For Paths, all the transformations are precomputed before the
+output is generated. Unfortunately scaling and rotation cannot be
+precomputed for labels and ellipses, so matrix operations are
+generated in the PostScript and SVG output.
%-----------------------------------------------------------------
@@ -260,18 +266,19 @@
In both PostScript and SVG mis-named fonts can cause somewhat
inscrutable printing anomalies - usually falling back to a default
-font but not always. Paricularly note, that PostScript fonts may
-only support glyphs in a limited set of sizes
-(10, 12, 18, 24, 26), for labels at other sizes the text should
-be drawn at a regular size then scaled once it has been lifted
-with the \texttt{frame} function to the Picture type.
+font but not always. PostScript may do no subsequent drawing after
+a font load error. \wumpuscore uses @scalefont@ in the generated
+PostScript, this semingly works for any integer size and not just
+the regular font sizes (10, 12, 18, 24, 36). Older versions of
+\wumpuscore mention that using non-standard sizes may cause font
+loading problems, however this does not appear to be the case.
+
The following table lists PostScript fonts and their SVG
equivalents. As of revision 0.20.0, the package
\texttt{wumpus-basic} includes a module
\texttt{Wumpus.Basic.SafeFonts} encoding the fonts in this list
-to avoid typographical slips...
-
+to avoid typographical slips.
\begin{tabular}{ l l }
diff --git a/doc/Guide.pdf b/doc/Guide.pdf
Binary files a/doc/Guide.pdf and b/doc/Guide.pdf differ
diff --git a/src/Wumpus/Core.hs b/src/Wumpus/Core.hs
--- a/src/Wumpus/Core.hs
+++ b/src/Wumpus/Core.hs
@@ -63,7 +63,6 @@
, module Wumpus.Core.VersionNumber
, module Wumpus.Core.WumpusTypes
-
) where
import Wumpus.Core.AffineTrans
@@ -78,3 +77,4 @@
import Wumpus.Core.TextEncoder
import Wumpus.Core.VersionNumber
import Wumpus.Core.WumpusTypes
+
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
@@ -155,6 +155,8 @@
+
+
-- | 3x3 matrix, considered to be in row-major form.
--
-- > (M3'3 a b c
@@ -218,6 +220,7 @@
lift2Vec2 op (V2 x y) (V2 x' y') = V2 (x `op` x') (y `op` y')
+
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)
@@ -238,6 +241,7 @@
instance Functor Point2 where
fmap f (P2 a b) = P2 (f a) (f b)
+
instance Functor Matrix3'3 where
fmap f (M3'3 m n o p q r s t u) =
M3'3 (f m) (f n) (f o) (f p) (f q) (f r) (f s) (f t) (f u)
@@ -267,6 +271,8 @@
-- Num
+
+
instance Num u => Num (Matrix3'3 u) where
(+) = lift2Matrix3'3 (+)
(-) = lift2Matrix3'3 (-)
@@ -335,6 +341,10 @@
-- scalar (dot / inner) product via the class InnerSpace
+-- This definition mandates UndecidableInstances, but this seems
+-- in line with Data.VectorSpace...
+--
+
instance (Num u, InnerSpace u, Scalar u ~ u)
=> InnerSpace (Vec2 u) where
(V2 a b) <.> (V2 a' b') = (a <.> a') ^+^ (b <.> b')
@@ -586,6 +596,8 @@
0 1 0
0 0 1
+
+
-- Common transformation matrices (for 2d homogeneous coordinates)
-- | Construct a scaling matrix:
@@ -599,6 +611,8 @@
0 sy 0
0 0 1
+
+
-- | Construct a translation matrix:
--
-- > (M3'3 1 0 x
@@ -610,10 +624,12 @@
0 1 y
0 0 1
+
+
-- | Construct a rotation matrix:
--
--- > (M3'3 cos(a) -sin(a) x
--- > sin(a) cos(a) y
+-- > (M3'3 cos(a) -sin(a) 0
+-- > sin(a) cos(a) 0
-- > 0 0 1 )
--
rotationMatrix :: (Floating u, Real u) => Radian -> Matrix3'3 u
@@ -622,6 +638,8 @@
0 0 1
where ang = fromRadian a
+
+
-- No reflectionMatrix function
-- A reflection about the x-axis is a scale of 1 (-1)
-- A reflection about the y-axis is a scale of (-1) 1
@@ -646,6 +664,10 @@
0 1 (-y)
0 0 1
+
+
+--------------------------------------------------------------------------------
+-- Matrix ops
-- | Invert a matrix.
diff --git a/src/Wumpus/Core/OutputPostScript.hs b/src/Wumpus/Core/OutputPostScript.hs
--- a/src/Wumpus/Core/OutputPostScript.hs
+++ b/src/Wumpus/Core/OutputPostScript.hs
@@ -51,7 +51,7 @@
-- | Output a series of pictures to a Postscript file. Each
-- picture will be printed on a separate page.
--
-writePS :: (Fractional u, Ord u, PSUnit u)
+writePS :: (Real u, Floating u, PSUnit u)
=> FilePath -> TextEncoder -> [Picture u] -> IO ()
writePS filepath enc pic = do
timestamp <- mkTimeStamp
@@ -61,7 +61,7 @@
-- The .eps file can then be imported or embedded in another
-- document.
--
-writeEPS :: (Fractional u, Ord u, PSUnit u)
+writeEPS :: (Real u, Floating u, PSUnit u)
=> FilePath -> TextEncoder -> Picture u -> IO ()
writeEPS filepath enc pic = do
timestamp <- mkTimeStamp
@@ -69,12 +69,12 @@
-- | Version of 'writePS' - using Latin1 encoding.
-writePS_latin1 :: (Fractional u, Ord u, PSUnit u)
+writePS_latin1 :: (Real u, Floating u, PSUnit u)
=> FilePath -> [Picture u] -> IO ()
writePS_latin1 filepath = writePS filepath latin1Encoder
-- | Version of 'writeEPS' - using Latin1 encoding.
-writeEPS_latin1 :: (Fractional u, Ord u, PSUnit u)
+writeEPS_latin1 :: (Real u, Floating u, PSUnit u)
=> FilePath -> Picture u -> IO ()
writeEPS_latin1 filepath = writeEPS filepath latin1Encoder
@@ -85,7 +85,7 @@
-- | Draw a picture, generating PostScript output.
-psDraw :: (Fractional u, Ord u, PSUnit u)
+psDraw :: (Real u, Floating u, PSUnit u)
=> String -> TextEncoder -> [Picture u] -> PostScript
psDraw timestamp enc pics = runWumpus enc $ do
psHeader 1 timestamp
@@ -95,7 +95,7 @@
pages = map (\i -> (show i,i)) [1..]
-psDrawPage :: (Fractional u, Ord u, PSUnit u)
+psDrawPage :: (Real u, Floating u, PSUnit u)
=> (String,Int) -> Picture u -> WumpusM ()
psDrawPage (lbl,ordinal) pic = do
dsc_Page lbl ordinal
@@ -113,7 +113,7 @@
-- | Note the bounding box may /below the origin/ - if it is, it
-- will need translating.
--
-epsDraw :: (Fractional u, Ord u, PSUnit u)
+epsDraw :: (Real u, Floating u, PSUnit u)
=> String -> TextEncoder -> Picture u -> PostScript
epsDraw timestamp enc pic = runWumpus enc $ do
epsHeader bb timestamp
@@ -164,7 +164,7 @@
-- are drawn when they are encountered as a @concat@ statement in a
-- block of @gsave ... grestore@.
--
-outputPicture :: (Fractional u, PSUnit u) => Picture u -> WumpusM ()
+outputPicture :: (Real u, Floating u, PSUnit u) => Picture u -> WumpusM ()
outputPicture (PicBlank _) = return ()
outputPicture (Single (fr,_) prim) =
updateFrame fr $ outputPrimitive prim
@@ -201,7 +201,7 @@
; ps_concat $ toCTM $ invert m1
}
-outputPrimitive :: (Fractional u, PSUnit u) => Primitive u -> WumpusM ()
+outputPrimitive :: (Real u, Floating u, PSUnit u) => Primitive u -> WumpusM ()
outputPrimitive (PPath (c,dp) p) = outputPath dp c p
outputPrimitive (PLabel props l) = updateFont props $ outputLabel l
outputPrimitive (PEllipse (c,dp) e) = outputEllipse dp c e
@@ -296,33 +296,51 @@
P2 x3 y3 = p3
--- | This is not very good as it uses a PostScript's
--- @scale@ operator - this will vary the line width during the
--- drawing of a stroked ellipse.
+-- | This is not very good - the use of PostScript's @concat@
+-- operator will vary the line width during the drawing of a
+-- stroked ellipse.
--
-outputEllipse :: (PSColour c, Fractional u, PSUnit u)
+outputEllipse :: (PSColour c, Real u, Floating u, PSUnit u)
=> DrawEllipse -> c -> PrimEllipse u -> WumpusM ()
-outputEllipse dp c (PrimEllipse (P2 x y) hw hh ctm) =
- concatInOut (ctm * scalingMatrix 1 (hh/hw)) (outputArc dp c x y hw)
-
+outputEllipse dp c (PrimEllipse pt@(P2 x y) hw hh ctm)
+ | hw==hh && ctm == identityCTM = outputArc dp c x y hw
+ | otherwise =
+ let matrix = matrixRepCTM $ scaleCTM 1 (hh/hw) ctm
+ matrix' = invert matrix
+ (P2 dx dy) = matrix' *# pt
+ in do { ps_concat $ toCTM matrix
+ ; outputArc dp c dx dy hw
+ ; ps_concat $ toCTM $ matrix'
+ }
outputArc :: (PSColour c, PSUnit u)
=> DrawEllipse -> c -> u -> u -> u -> WumpusM ()
outputArc EFill c x y r = updateColour c $ do
+ ps_newpath
ps_arc x y r 0 360
ps_closepath
ps_fill
outputArc (EStroke xs) c x y r = updatePen c xs $ do
+ ps_newpath
ps_arc x y r 0 360
ps_closepath
ps_stroke
-outputLabel :: (PSUnit u, Fractional u) => Label u -> WumpusM ()
-outputLabel (Label (P2 x y) entxt ctm) = do
- ps_moveto x y
- concatInOut ctm $ outputEncodedText entxt
+-- Note - for the otherwise case the x-and-y coordinates are
+-- encoded in the matrix, hence the @ 0 0 moveto @.
+--
+outputLabel :: (Real u, Floating u, PSUnit u) => Label u -> WumpusM ()
+outputLabel (Label (P2 x y) entxt ctm)
+ | ctm == identityCTM = do { ps_moveto x y; outputEncodedText entxt }
+ | otherwise = do { ps_concat $ toCTM matrix
+ ; ps_moveto 0 (0 :: Double)
+ ; outputEncodedText entxt
+ ; ps_concat $ toCTM $ invert matrix
+ }
+ where
+ matrix = translMatrixRepCTM x y ctm
outputEncodedText :: EncodedText -> WumpusM ()
outputEncodedText = mapM_ outputTextChunk . getEncodedText
@@ -343,12 +361,3 @@
ps_glyphshow fallback
-
-concatInOut :: (PSUnit u, Fractional u)
- => Matrix3'3 u -> WumpusM a -> WumpusM ()
-concatInOut m1 ma | m1 == identityMatrix = ma >> return ()
- | otherwise = do { ps_concat $ toCTM m1
- ; _ <- ma
- ; ps_concat $ toCTM $ invert m1
- }
-
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
@@ -60,28 +60,34 @@
type Clipped = Bool
-coordChange :: (Num u, Ord u, Scale t, u ~ DUnit t) => t -> t
+coordChange :: (Num u, Scale t, u ~ DUnit t) => t -> t
coordChange = scale 1 (-1)
svg_reflection_matrix :: Num u => Matrix3'3 u
-svg_reflection_matrix = M3'3 1 0 0 0 (-1) 0 0 0 1
+svg_reflection_matrix = scalingMatrix 1 (-1)
--------------------------------------------------------------------------------
-- | Output a picture to a SVG file.
-writeSVG :: (Ord u, PSUnit u) => FilePath -> TextEncoder -> Picture u -> IO ()
+--
+writeSVG :: (Real u, Floating u, PSUnit u)
+ => FilePath -> TextEncoder -> Picture u -> IO ()
writeSVG filepath enc pic =
writeFile filepath $ unlines $ map ppContent $ svgDraw enc pic
-- | Version of 'writeSVG' - using Latin1 encoding.
-writeSVG_latin1 :: (Ord u, PSUnit u) => FilePath -> Picture u -> IO ()
+--
+writeSVG_latin1 :: (Real u, Floating u, PSUnit u)
+ => FilePath -> Picture u -> IO ()
writeSVG_latin1 filepath = writeSVG filepath latin1Encoder
-svgDraw :: (Ord u, PSUnit u) => TextEncoder -> Picture u -> [Content]
-svgDraw enc pic = runSVG enc $
- picture False pic' >>= return . topLevelPic mbvec >>= prefixXmlDecls
+svgDraw :: (Real u, Floating u, PSUnit u)
+ => TextEncoder -> Picture u -> [Content]
+svgDraw enc pic = runSVG enc $ do
+ elem1 <- picture False pic'
+ prefixXmlDecls (topLevelPic mbvec elem1)
where
pic' = coordChange pic
(_,mbvec) = repositionProperties pic'
@@ -101,7 +107,8 @@
-picture :: (Ord u, PSUnit u) => Clipped -> Picture u -> SvgM Element
+picture :: (Real u, Floating u, PSUnit u)
+ => Clipped -> Picture u -> SvgM Element
picture _ (PicBlank _) = return $ gElement [] []
picture c (Single (fr,_) prim) = do
elt <- primitive c prim
@@ -120,7 +127,8 @@
return $ gElement (maybe [] return $ frameChange fr) [cp,e1]
-primitive :: (Ord u, PSUnit u) => Clipped -> Primitive u -> SvgM Element
+primitive :: (Real u, Floating u, PSUnit u)
+ => Clipped -> Primitive u -> SvgM Element
primitive c (PPath props p) = clipAttrib c $ path props p
primitive c (PLabel props l) = clipAttrib c $ label props l
primitive c (PEllipse props e) = clipAttrib c $ ellipse props e
@@ -163,22 +171,35 @@
-- Also rendering coloured text is convoluted (needing the
-- tspan element).
--
-label :: (Ord u, PSUnit u) => LabelProps -> Label u -> SvgM Element
+--
+label :: (Real u, Floating u, PSUnit u)
+ => LabelProps -> Label u -> SvgM Element
label (c,FontAttr _ fam style sz) (Label pt entxt ctm) = do
str <- encodedText entxt
let tspan_elt = element_tspan str `snoc_attrs` [ attr_fill c ]
- return $ element_text tspan_elt `snoc_attrs` text_xs
+ return $ element_text tspan_elt `snoc_attrs` coord_attrs
+ `snoc_attrs` font_attrs
`snoc_attrs` (fontStyle style)
where
- P2 x y = coordChange pt
- text_xs = withCTM (ctm * svg_reflection_matrix) $
- [ attr_x x
- , attr_y y
- , attr_font_family fam
+ coord_attrs = if ctm == identityCTM then simpleLabelAttrs pt
+ else transfLabelAttrs pt ctm
+ font_attrs = [ attr_font_family fam
, attr_font_size sz
]
-
+
+simpleLabelAttrs :: PSUnit u => Point2 u -> [Attr]
+simpleLabelAttrs pt = [ attr_x x, attr_y y, attr_transform mtrx]
+ where
+ P2 x y = coordChange pt
+ mtrx = val_matrix 1 0 0 (-1) 0 (0::Double)
+transfLabelAttrs :: (Real u, Floating u, PSUnit u)
+ => Point2 u -> PrimCTM u -> [Attr]
+transfLabelAttrs (P2 x y) ctm =
+ [ attr_x (0::Double), attr_y (0 :: Double), attr_transform vmtrx]
+ where
+ mtrx = translMatrixRepCTM x y ctm * svg_reflection_matrix
+ vmtrx = valMatrix mtrx
encodedText :: EncodedText -> SvgM String
@@ -215,19 +236,53 @@
-- If w==h the draw the ellipse as a circle
-ellipse :: PSUnit u => EllipseProps -> PrimEllipse u -> SvgM Element
-ellipse (c,dp) (PrimEllipse (P2 x y) w h ctm)
- | w == h = return $ element_circle
+ellipse :: (Real u, Floating u, PSUnit u)
+ => EllipseProps -> PrimEllipse u -> SvgM Element
+ellipse (c,dp) (PrimEllipse pt hw hh ctm)
+ | hw == hh = return $ element_circle
`snoc_attrs` (circle_attrs ++ style_attrs)
| otherwise = return $ element_ellipse
`snoc_attrs` (ellipse_attrs ++ style_attrs)
where
- circle_attrs = withCTM ctm $ [attr_cx x, attr_cy y, attr_r w]
- ellipse_attrs = withCTM ctm $ [attr_cx x, attr_cy y, attr_rx w, attr_ry h]
+ circle_attrs = if ctm == identityCTM
+ then simpleCircleAttrs pt hw
+ else transfCircleAttrs pt hw ctm
+
+ ellipse_attrs = if ctm == identityCTM
+ then simpleEllipseAttrs pt hw hh
+ else transfEllipseAttrs pt hw hh ctm
+
style_attrs = fill_a : stroke_a : opts
where (fill_a,stroke_a,opts) = drawEllipse c dp
+simpleCircleAttrs :: PSUnit u => Point2 u -> u -> [Attr]
+simpleCircleAttrs (P2 x y) radius = [attr_cx x, attr_cy y, attr_r radius]
+simpleEllipseAttrs :: PSUnit u => Point2 u -> u -> u -> [Attr]
+simpleEllipseAttrs (P2 x y) hw hh =
+ [attr_cx x, attr_cy y, attr_rx hw, attr_ry hh]
+
+
+transfCircleAttrs :: (Real u, Floating u, PSUnit u)
+ => Point2 u -> u -> PrimCTM u -> [Attr]
+transfCircleAttrs (P2 x y) radius ctm =
+ [ attr_cx (0::Double), attr_cy (0::Double), attr_r radius
+ , attr_transform vmtrx ]
+ where
+ mtrx = translMatrixRepCTM x y ctm * svg_reflection_matrix
+ vmtrx = valMatrix mtrx
+
+
+transfEllipseAttrs :: (Real u, Floating u, PSUnit u)
+ => Point2 u -> u -> u -> PrimCTM u -> [Attr]
+transfEllipseAttrs (P2 x y) hw hh ctm =
+ [ attr_cx (0::Double), attr_cy (0::Double), attr_rx hw, attr_ry hh
+ , attr_transform vmtrx ]
+ where
+ mtrx = translMatrixRepCTM x y ctm * svg_reflection_matrix
+ vmtrx = valMatrix mtrx
+
+
-- A rule of thumb seems to be that SVG (at least SVG in Firefox)
-- will try to fill unless told not to. So always label paths
-- with @fill=...@ even if fill is @\"none\"@.
@@ -293,9 +348,9 @@
snoc_attrs :: Element -> [Attr] -> Element
snoc_attrs = flip add_attrs
-withCTM :: PSUnit u => Matrix3'3 u -> [Attr] -> [Attr]
-withCTM mtrx attrs | mtrx == identityMatrix = attrs
- | otherwise = mtrx_attr : attrs
+
+
+valMatrix :: PSUnit u => Matrix3'3 u -> String
+valMatrix m33 = val_matrix a b c d x y
where
- mtrx_attr = attr_transform $ val_matrix a b c d e f
- CTM a b c d e f = toCTM mtrx
+ CTM a b c d x y = toCTM m33
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
@@ -102,7 +102,7 @@
-- | Lift a 'Primitive' to a 'Picture', located in the standard frame.
--
-frame :: (Fractional u, Floating u, Ord u) => Primitive u -> Picture u
+frame :: (Real u, Floating u) => Primitive u -> Picture u
frame p = Single (stdFrame, boundary p) p
-- | Frame a picture within the supplied bounding box
@@ -119,7 +119,7 @@
-- ellipse. Thus the bounding box will never reframed to a
-- smaller size than the /natural/ bounding box.
--
-frameWithin :: (Fractional u, Floating u, Ord u)
+frameWithin :: (Real u, Floating u)
=> Primitive u -> BoundingBox u -> Picture u
frameWithin p@(PLabel _ _) bb = Single (stdFrame,bb) p
frameWithin p bb = Single (stdFrame,bb `append` boundary p) p
@@ -135,7 +135,7 @@
--
-- This function throws an error when supplied the empty list.
--
-frameMulti :: (Fractional u, Floating u, Ord u)
+frameMulti :: (Real u, Floating u)
=> [Primitive u] -> Picture u
frameMulti [] = error "Wumpus.Core.Picture.frameMulti - empty list"
frameMulti xs = multi $ map frame xs
@@ -216,12 +216,10 @@
-- Take Paths to Primitives
-ostrokePath :: (Num u, Ord u)
- => PSRgb -> [StrokeAttr] -> Path u -> Primitive u
+ostrokePath :: Num u => PSRgb -> [StrokeAttr] -> Path u -> Primitive u
ostrokePath c attrs p = PPath (c, OStroke attrs) p
-cstrokePath :: (Num u, Ord u)
- => PSRgb -> [StrokeAttr] -> Path u -> Primitive u
+cstrokePath :: Num u => PSRgb -> [StrokeAttr] -> Path u -> Primitive u
cstrokePath c attrs p = PPath (c, CStroke attrs) p
-- | Create a open, stroked path (@ostroke@) or a closed, stroked
@@ -231,8 +229,8 @@
-- the path more convenient.
--
class Stroke t where
- ostroke :: (Num u, Ord u) => t -> Path u -> Primitive u
- cstroke :: (Num u, Ord u) => t -> Path u -> Primitive u
+ ostroke :: Num u => t -> Path u -> Primitive u
+ cstroke :: Num u => t -> Path u -> Primitive u
instance Stroke () where
ostroke () = ostrokePath psBlack []
@@ -288,12 +286,12 @@
-- | Create an open stoke coloured black.
--
-zostroke :: (Num u, Ord u) => Path u -> Primitive u
+zostroke :: Num u => Path u -> Primitive u
zostroke = ostrokePath psBlack []
-- | Create a closed stroke coloured black.
--
-zcstroke :: (Num u, Ord u) => Path u -> Primitive u
+zcstroke :: Num u => Path u -> Primitive u
zcstroke = cstrokePath psBlack []
@@ -302,7 +300,7 @@
-fillPath :: (Num u, Ord u) => PSRgb -> Path u -> Primitive u
+fillPath :: Num u => PSRgb -> Path u -> Primitive u
fillPath c p = PPath (c,CFill) p
-- | Create a filled path (@fill@). Fills only have one
@@ -312,7 +310,7 @@
-- @ fill () @ will fill with the default colour - black.
--
class Fill t where
- fill :: (Num u, Ord u) => t -> Path u -> Primitive u
+ fill :: Num u => t -> Path u -> Primitive u
instance Fill () where fill () = fillPath psBlack
@@ -321,7 +319,7 @@
instance Fill (Gray Double) where fill = fillPath . psColour
-- | Create a filled path coloured black.
-zfill :: (Num u, Ord u) => Path u -> Primitive u
+zfill :: Num u => Path u -> Primitive u
zfill = fillPath psBlack
--------------------------------------------------------------------------------
@@ -339,7 +337,7 @@
mkTextLabel :: Num u => PSRgb -> FontAttr -> String -> Point2 u -> Primitive u
mkTextLabel c attr txt pt = PLabel (c,attr) lbl
where
- lbl = Label pt (lexLabel txt) identityMatrix
+ lbl = Label pt (lexLabel txt) identityCTM
-- | Create a text label. The string should not contain newline
@@ -393,7 +391,7 @@
mkEllipse :: Num u
=> PSRgb -> DrawEllipse -> u -> u -> Point2 u -> Primitive u
-mkEllipse c dp hw hh pt = PEllipse (c,dp) (PrimEllipse pt hw hh identityMatrix)
+mkEllipse c dp hw hh pt = PEllipse (c,dp) (PrimEllipse pt hw hh identityCTM)
ellipseDefault :: EllipseProps
@@ -533,7 +531,7 @@
-- Draw the picture on top of an image of its bounding box.
-- The bounding box image will be drawn in the supplied colour.
--
-illustrateBounds :: (Floating u, Ord u) => DRGB -> Picture u -> Picture u
+illustrateBounds :: (Real u, Floating u) => DRGB -> Picture u -> Picture u
illustrateBounds rgb p = p `picOver` (frameMulti $ boundsPrims rgb p)
@@ -544,7 +542,7 @@
--
-- The result will be lifted from Primitive to Picture.
--
-illustrateBoundsPrim :: (Floating u, Ord u)
+illustrateBoundsPrim :: (Real u, Floating u)
=> DRGB -> Primitive u -> Picture u
illustrateBoundsPrim rgb p = frameMulti (boundsPrims rgb p ++ [p])
@@ -575,7 +573,7 @@
-- curves - they are implemented with PostScript\'s
-- @arc@ command.
--
-illustrateControlPoints :: (Floating u, Ord u)
+illustrateControlPoints :: (Real u, Floating u)
=> DRGB -> Primitive u -> Picture u
illustrateControlPoints rgb prim = step prim
where
@@ -608,8 +606,8 @@
-- Two lines for each quadrant:
-- start-point to control-point1; control-point2 to end-point
--
-ellipseCtrlLines :: (Floating u, Ord u)
- => DRGB -> PrimEllipse u -> [Primitive u]
+ellipseCtrlLines :: (Real u, Floating u)
+ => DRGB -> PrimEllipse u -> [Primitive u]
ellipseCtrlLines rgb pe = start all_points
where
-- list in order:
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
@@ -1,6 +1,5 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS -Wall #-}
--------------------------------------------------------------------------------
@@ -32,6 +31,7 @@
, DLabel
, PrimEllipse(..)
, DPrimEllipse
+ , PrimCTM
, PathProps -- hide in Wumpus.Core export?
, LabelProps -- hide in Wumpus.Core export?
@@ -43,6 +43,19 @@
-- * Type class
, PSUnit(..)
+
+
+ -- * Transformations on Primitives
+ , translatePrimitive
+ , rotatePrimitive
+ , scalePrimitive
+ , uniformScalePrimitive
+
+ -- * PrimCTM
+ , identityCTM
+ , scaleCTM
+ , matrixRepCTM
+ , translMatrixRepCTM
-- * Extras
, mapLocale
@@ -67,7 +80,7 @@
import Data.AffineSpace
import Data.Semigroup
-import Text.PrettyPrint.Leijen
+import Text.PrettyPrint.Leijen -- package: wl-pprint
@@ -171,7 +184,7 @@
data Label u = Label
{ label_bottom_left :: Point2 u
, label_text :: EncodedText
- , label_CTM :: Matrix3'3 u
+ , label_ctm :: PrimCTM u
}
deriving (Eq,Show)
@@ -183,12 +196,17 @@
{ ellipse_center :: Point2 u
, ellipse_half_width :: u
, ellipse_half_height :: u
- , ellispe_CTM :: Matrix3'3 u
+ , ellipse_ctm :: PrimCTM u
}
deriving (Eq,Show)
type DPrimEllipse = PrimEllipse Double
+
+data PrimCTM u = PrimCTM { _xscale :: u, _yscale :: u, _rot :: Radian }
+ deriving (Eq,Show)
+
+
-- | Note when drawn /filled/ and drawn /stroked/ the same
-- polygon will have (slightly) different size:
--
@@ -229,6 +247,9 @@
type Locale u = (Frame2 u, BoundingBox u)
+
+
+
--------------------------------------------------------------------------------
-- Pretty printing
@@ -257,25 +278,25 @@
pretty (Path pt ps) = pretty pt <> hcat (map pretty ps)
instance Pretty u => Pretty (PathSegment u) where
- pretty (PCurveTo p1 p2 p3) = text ".*" <> pretty p1 <> text ",," <> pretty p2
+ pretty (PCurveTo p1 p2 p3) = text ".*" <> pretty p1 <> text ",," <> pretty p2
<> text "*." <> pretty p3
- pretty (PLineTo pt) = text "--" <> pretty pt
+ pretty (PLineTo pt) = text "--" <> pretty pt
instance Pretty u => Pretty (Label u) where
pretty (Label pt s ctm) = dquotes (pretty s) <> char '@' <> pretty pt
- <+> ppMatrixCTM ctm
+ <+> pretty ctm
instance Pretty u => Pretty (PrimEllipse u) where
- pretty (PrimEllipse c w h ctm) = pretty "ellipse" <+> pretty c
- <+> text "w:" <> pretty w
- <+> text "h:" <> pretty h
- <+> ppMatrixCTM ctm
-
-ppMatrixCTM :: Pretty u => Matrix3'3 u -> Doc
-ppMatrixCTM = pp . toCTM where
- pp (CTM a b c d x y) = list $ map pretty [a,b,c,d,x,y]
+ pretty (PrimEllipse ctr w h ctm) = pretty "ellipse" <+> pretty ctr
+ <+> text "w:" <> pretty w
+ <+> text "h:" <> pretty h
+ <+> pretty ctm
+instance Pretty u => Pretty (PrimCTM u) where
+ pretty (PrimCTM x y ang) =
+ braces (pretty x <> comma <+> pretty y <> comma <+> pretty ang)
+
--------------------------------------------------------------------------------
-- | Paths are sensibly a Semigroup - there is no notion of
@@ -305,7 +326,7 @@
type instance DUnit (PrimEllipse u) = u
instance (Num u, Ord u) => Transform (Picture u) where
- transform ctm pic = transformPicture (transform ctm) (transform ctm) pic
+ transform ctm pic = trafoPicture (transform ctm) (transform ctm) pic
instance (Floating u, Real u) => Rotate (Picture u) where
@@ -321,168 +342,240 @@
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
+-- Primitives
- transform ctm (PEllipse attr ell) = PEllipse attr $ transformEllipse ctm ell
+-- | Rotate a Primitive.
+--
+-- Note - this is not an affine transformation as Primitives are
+-- not regarded as being in an affine frame.
+--
+-- * Paths are rotated about their start point.
+--
+-- * Labels are rotated about the bottom-left corner.
+--
+-- * Ellipses are rotated about the center.
+--
+-- For Primitives and Ellipses applying a rotation and or a scale
+-- will generate an additional matrix transformation in the
+-- generated PostScript. For Paths all transformations are
+-- \"cost-free\".
+--
+rotatePrimitive :: (Real u, Floating u)
+ => Radian -> Primitive u -> Primitive u
+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
-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
- rotate ang (PEllipse attr ell) = PEllipse attr $ rotateEllipse ang ell
-instance (Real u, Floating u) => RotateAbout (Primitive u) where
- rotateAbout ang pt (PPath attr path) =
- PPath attr $ rotatePathAbout ang pt path
+-- | Scale a Primitive.
+--
+-- Note - this is not an affine transformation as Primitives are
+-- not regarded as being in an affine frame.
+--
+-- An affine scaling uniformly scales all the elements in a
+-- Picture. It is just a change of the Picture\'s basis vectors.
+-- The elements within the Picture are unchanged - though
+-- obviously rendering changes according to the transformation.
+--
+-- By contrast, the scaling operation on Primitives changes the
+-- properties of the object as it is applied - e.g. for a path
+-- the vector between the start point and all subsequent points
+-- is changed with respect to the x,y scaling factors; for an
+-- ellipse the half-width and half-height of the ellipse is
+-- scaled.
+--
+-- For Primitives and Ellipses applying a rotation and or a scale
+-- will generate an additional matrix transformation in the
+-- generated PostScript. For Paths all transformations are
+-- \"cost-free\".
+--
+scalePrimitive :: Num u => u -> u -> Primitive u -> Primitive u
+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
- rotateAbout ang pt (PLabel attr lbl) =
- PLabel attr $ rotateLabelAbout ang pt lbl
+-- | Apply a uniform scale to a Primitive.
+--
+uniformScalePrimitive :: Num u => u -> Primitive u -> Primitive u
+uniformScalePrimitive d = scalePrimitive d d
- rotateAbout ang pt (PEllipse attr ell) =
- PEllipse attr $ rotateEllipseAbout ang pt ell
+-- | Translate a primitive.
+--
+-- Translation is essentially \"cost-free\" for the generated
+-- PostScript or SVG. Paths are translated before the PostScript
+-- is generated. For Ellipses and Labels, translation will
+-- either move the bottom-left origin (Label) or center
+-- (Ellipse); or if they are also scaled or rotated the
+-- 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 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
-instance Num u => Scale (Primitive u) where
- scale x y (PPath attr path) = PPath attr $ scalePath x y path
- scale x y (PLabel attr lbl) = PLabel attr $ scaleLabel x y lbl
- scale x y (PEllipse attr ell) = PEllipse attr $ scaleEllipse x y ell
-
-instance Num u => Translate (Primitive u) where
- translate x y (PPath attr path) = PPath attr $ translatePath x y path
- translate x y (PLabel attr lbl) = PLabel attr $ translateLabel x y lbl
- translate x y (PEllipse attr ell) = PEllipse attr $ translateEllipse x y ell
-
--------------------------------------------------------------------------------
-- Helpers for the affine transformations
rotatePicture :: (Real u, Floating u) => Radian -> Picture u -> Picture u
-rotatePicture ang = transformPicture (rotate ang) (rotate ang)
-
+rotatePicture ang = trafoPicture (rotate ang) (rotate ang)
rotatePictureAbout :: (Real u, Floating u)
=> Radian -> Point2 u -> Picture u -> Picture u
rotatePictureAbout ang pt =
- transformPicture (rotateAbout ang pt) (rotateAbout ang pt)
+ trafoPicture (rotateAbout ang pt) (rotateAbout ang pt)
scalePicture :: (Num u, Ord u) => u -> u -> Picture u -> Picture u
-scalePicture x y = transformPicture (scale x y) (scale x y)
+scalePicture x y = trafoPicture (scale x y) (scale x y)
translatePicture :: (Num u, Ord u) => u -> u -> Picture u -> Picture u
-translatePicture x y = transformPicture (translate x y) (translate x y)
+translatePicture x y = trafoPicture (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)
- -> Picture u
- -> Picture u
-transformPicture fp fv =
- mapLocale $ \(frm,bb) -> (transformFrame fp fv frm, transformBBox fp bb)
+trafoPicture :: (Num u, Ord u)
+ => (Point2 u -> Point2 u)
+ -> (Vec2 u -> Vec2 u)
+ -> Picture u
+ -> Picture u
+trafoPicture fp fv =
+ mapLocale $ \(frm,bb) -> (trafoFrame fp fv frm, trafoBBox fp bb)
-transformFrame :: Num u
- => (Point2 u -> Point2 u)
- -> (Vec2 u -> Vec2 u)
- -> Frame2 u
- -> Frame2 u
-transformFrame fp fv (Frame2 e0 e1 o) = Frame2 (fv e0) (fv e1) (fp o)
+trafoFrame :: Num u
+ => (Point2 u -> Point2 u)
+ -> (Vec2 u -> Vec2 u)
+ -> Frame2 u
+ -> Frame2 u
+trafoFrame fp fv (Frame2 e0 e1 o) = Frame2 (fv e0) (fv e1) (fp o)
-- Bounding boxes need recalculating after a transformation.
-- For instance after a reflection in the y-axis br becomes bl.
-transformBBox :: (Num u, Ord u)
+trafoBBox :: (Num u, Ord u)
=> (Point2 u -> Point2 u) -> BoundingBox u -> BoundingBox u
-transformBBox fp bb = traceBoundary $ map fp $ [bl,br,tl,tr]
+trafoBBox fp bb = traceBoundary $ map fp $ [bl,br,tl,tr]
where
(bl,br,tr,tl) = corners bb
-
+--------------------------------------------------------------------------------
-- Paths
-rotatePath :: (Real u, Floating u) => Radian -> Path u -> Path u
-rotatePath ang = transformPath (rotate ang)
+-- Cannot support general matrix transform or rotateAbout on
+-- Ellipses or Labels so there are not supported on Paths.
+--
-rotatePathAbout :: (Real u, Floating u)
- => Radian -> Point2 u -> Path u -> Path u
-rotatePathAbout ang pt = transformPath (rotateAbout ang pt)
+-- rotatePath - rotate the path about its start point.
+--
+-- This is a visually intuitive interpretation - Primitives are
+-- not in an affine space (they have an origin, i.e. the location
+-- (0,0), but don\'t not basis vectors) so manipulating them
+-- cannot follow the standard affine interpretation.
+--
+rotatePath :: (Real u, Floating u) => Radian -> Path u -> Path u
+rotatePath ang (Path start xs) =
+ Path start $ map (pointwise (rotateAbout ang start)) xs
+-- scalePath - scale the vector between each point and the start
+-- point.
+--
+-- This produces visually inituitive results. As primitives
+-- don\'t exist in an affine space / affine frame until they
+-- are lifted to Pictures their manipulation cannot correspond
+-- to the standard affine manipulations.
+--
scalePath :: Num u => u -> u -> Path u -> Path u
-scalePath x y = transformPath (scale x y)
+scalePath x y (Path pt xs) = Path pt (map (pointwise fn) xs)
+ where
+ fn p1 = let dif = p1 .-. pt in pt .+^ (scale x y $ dif)
+-- translatePath - move all points in the path by the supplied
+-- x and y values.
+--
translatePath :: Num u => u -> u -> Path u -> Path u
-translatePath x y = transformPath (translate x y)
+translatePath x y = pointwise (translate x y)
-transformPath :: (Point2 u -> Point2 u) -> Path u -> Path u
-transformPath fp (Path start ss) =
- Path (fp start) (map (transformPathSegment fp) ss)
--- Path Segments
+--------------------------------------------------------------------------------
+-- Manipulating the Primitive CTM
-transformPathSegment :: (Point2 u -> Point2 u) -> PathSegment u -> PathSegment u
-transformPathSegment fp = pointwise fp
+identityCTM :: Num u => PrimCTM u
+identityCTM = PrimCTM 1 1 0
+scaleCTM :: Num u => u -> u -> PrimCTM u -> PrimCTM u
+scaleCTM x1 y1 (PrimCTM x y ang) = PrimCTM (x1*x) (y1*y) ang
+
+rotateCTM :: Radian -> PrimCTM u -> PrimCTM u
+rotateCTM ang1 (PrimCTM x y ang) = PrimCTM x y (ang1+ang)
+
+matrixRepCTM :: (Floating u, Real u) => PrimCTM u -> Matrix3'3 u
+matrixRepCTM (PrimCTM x y ang) =
+ rotationMatrix (circularModulo ang) * scalingMatrix x y
+
+
+-- Note - the order of combining a translation (i.e. the
+-- location of a point) and the CTM is crucial as matrix
+-- multiplication is not commutative.
+--
+-- The function encapsulated the correct order.
+--
+translMatrixRepCTM :: (Floating u, Real u)
+ => u -> u -> PrimCTM u -> Matrix3'3 u
+translMatrixRepCTM x y ctm = translationMatrix x y * matrixRepCTM ctm
+
+--------------------------------------------------------------------------------
-- 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)
--- rotate CTM and pt or just CTM ??
-rotateLabelAbout :: (Real u, Floating u)
- => Radian -> Point2 u -> Label u -> Label u
-rotateLabelAbout ang rpt (Label pt txt ctm) =
- Label pt txt (ctm * originatedRotationMatrix ang rpt)
+-- Rotations on a (primitive) Label are interpreted as rotating
+-- about the bottom-left corner.
+--
+rotateLabel :: Radian -> Label u -> Label u
+rotateLabel ang (Label pt txt ctm) = Label pt txt (rotateCTM ang ctm)
scaleLabel :: Num u => u -> u -> Label u -> Label u
-scaleLabel x y (Label pt txt ctm) = Label pt txt (ctm * scalingMatrix x y)
+scaleLabel x y (Label pt txt ctm) = Label pt txt (scaleCTM x y ctm)
--- no need to change CTM for translation (??)
+
+-- Change the bottom-left corner.
+--
translateLabel :: Num u => u -> u -> Label u -> Label u
translateLabel x y (Label pt txt ctm) = Label (translate x y pt) txt ctm
+--------------------------------------------------------------------------------
+-- Ellipse
---
-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 :: Radian -> PrimEllipse u -> PrimEllipse u
rotateEllipse ang (PrimEllipse pt hw hh ctm) =
- PrimEllipse pt hw hh (ctm * rotationMatrix ang)
-
-rotateEllipseAbout :: (Real u, Floating u)
- => Radian -> Point2 u -> PrimEllipse u -> PrimEllipse u
-rotateEllipseAbout ang rpt (PrimEllipse pt hw hh ctm) =
- PrimEllipse pt hw hh (ctm * originatedRotationMatrix ang rpt)
+ PrimEllipse pt hw hh (rotateCTM ang ctm)
+
scaleEllipse :: Num u => u -> u -> PrimEllipse u -> PrimEllipse u
scaleEllipse x y (PrimEllipse pt hw hh ctm) =
- PrimEllipse pt hw hh (ctm * scalingMatrix x y)
+ PrimEllipse (translate x y pt) hw hh (scaleCTM x y ctm)
+
+-- Change the point
+--
translateEllipse :: Num u => u -> u -> PrimEllipse u -> PrimEllipse u
translateEllipse x y (PrimEllipse pt hw hh ctm) =
PrimEllipse (translate x y pt) hw hh ctm
+
--------------------------------------------------------------------------------
-- Boundary
@@ -502,20 +595,24 @@
-- Note - this will calculate an approximate bounding box for
-- text.
-instance (Fractional u, Floating u, Ord u) => Boundary (Primitive u) where
+instance (Real u, Floating u) => Boundary (Primitive u) where
boundary (PPath _ p) = boundary p
boundary (PLabel (_,a) l) = primLabelBoundary a l
boundary (PEllipse _ e) = boundary e
-primLabelBoundary :: (Fractional u, Ord u)
+
+
+primLabelBoundary :: (Floating u, Real u)
=> FontAttr -> Label u -> BoundingBox u
-primLabelBoundary attr (Label pt xs ctm) =
- retraceBoundary (ctm *#) untraf_bbox
+primLabelBoundary attr (Label (P2 x y) xs ctm) =
+ retraceBoundary (disp . (m33 *#)) untraf_bbox
where
- untraf_bbox = textBounds (font_size attr) pt char_count
+ disp = (.+^ V2 x y)
+ m33 = matrixRepCTM ctm
+ untraf_bbox = textBounds (font_size attr) zeroPt char_count
char_count = textLength xs
-instance (Floating u, Ord u) => Boundary (PrimEllipse u) where
+instance (Real u, Floating u) => Boundary (PrimEllipse u) where
boundary = ellipseBoundary
-- Find the bbox of an ellipse by drawing it as four bezier
@@ -527,7 +624,7 @@
-- /matched/ start-end points
--
-ellipseBoundary :: (Floating u, Ord u) => PrimEllipse u -> BoundingBox u
+ellipseBoundary :: (Real u, Floating u) => PrimEllipse u -> BoundingBox u
ellipseBoundary = traceBoundary . ellipseControlPoints
-- PROBLEM:
@@ -542,6 +639,8 @@
--
+
+
mapLocale :: (Locale u -> Locale u) -> Picture u -> Picture u
mapLocale f (PicBlank m) = PicBlank (f m)
mapLocale f (Single m prim) = Single (f m) prim
@@ -577,7 +676,8 @@
-- (P2 4 4) gives a 4 pt margin - maybe it sould be (0,0) or
-- user defined.
--
-repositionProperties :: (Num u, Ord u) => Picture u -> (BoundingBox u, Maybe (Vec2 u))
+repositionProperties :: (Num u, Ord u)
+ => Picture u -> (BoundingBox u, Maybe (Vec2 u))
repositionProperties = fn . boundary where
fn bb@(BBox (P2 llx lly) (P2 urx ury))
| llx < 4 || lly < 4 = (BBox ll ur, Just $ V2 x y)
@@ -595,13 +695,15 @@
-- /wrap-around/. We take 4 points initially (start,cp1,cp2,end)
-- then (cp1,cp2,end) for the other three quadrants.
--
-ellipseControlPoints :: (Floating u, Ord u)
+ellipseControlPoints :: (Floating u, Real u)
=> PrimEllipse u -> [Point2 u]
-ellipseControlPoints (PrimEllipse ctr hw hh ctm) = map (new_mtrx *#) circ
+ellipseControlPoints (PrimEllipse (P2 x y) hw hh ctm) =
+ map (disp . (new_mtrx *#)) circ
where
+ disp = (.+^ V2 x y)
(radius,(dx,dy)) = circleScalingProps hw hh
- new_mtrx = ctm * scalingMatrix dx dy
- circ = bezierCircle 1 radius ctr
+ new_mtrx = matrixRepCTM $ scaleCTM dx dy ctm
+ circ = bezierCircle 1 radius (P2 0 0)
-- subdivide the bezierCircle with 1 to get two
-- control points per quadrant.
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,4 +22,4 @@
wumpus_core_version :: (Int,Int,Int)
-wumpus_core_version = (0,20,0)
+wumpus_core_version = (0,21,0)
diff --git a/src/Wumpus/Core/WumpusTypes.hs b/src/Wumpus/Core/WumpusTypes.hs
--- a/src/Wumpus/Core/WumpusTypes.hs
+++ b/src/Wumpus/Core/WumpusTypes.hs
@@ -38,11 +38,18 @@
, DLabel
-- * Drawing styles
- , PathProps -- Better hidden?
- , LabelProps -- "
- , EllipseProps -- "
- , DrawPath -- "
- , DrawEllipse -- "
+ , PathProps
+ , LabelProps
+ , EllipseProps
+ , DrawPath
+ , DrawEllipse
+
+ -- * Transformations on Primitives
+ , translatePrimitive
+ , rotatePrimitive
+ , scalePrimitive
+ , uniformScalePrimitive
+
) where
diff --git a/src/Wumpus/Extra/PictureLanguage.hs b/src/Wumpus/Extra/PictureLanguage.hs
--- a/src/Wumpus/Extra/PictureLanguage.hs
+++ b/src/Wumpus/Extra/PictureLanguage.hs
@@ -540,10 +540,10 @@
--
-- An error is throw if the list of strings is empty
--
-multilabel :: (Fractional u, Floating u, Ord u, TextLabel t)
+multilabel :: (Real u, Floating u, TextLabel t)
=> t -> u -> VAlign -> [String] -> Point2 u -> Picture u
multilabel _ _ _ [] _ = error $
- "Wumpus.Core.Picture.multilabel - empty list."
+ "Wumpus.Core.PictureLanguage.multilabel - empty list."
multilabel attr n va (x:xs) pt =
moveAll $ vsepA va n line1 (map mkPic xs)
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.20.0
+version: 0.21.0
license: BSD3
license-file: LICENSE
copyright: Stephen Tetley
@@ -61,24 +61,32 @@
.
Changelog:
.
- 0.19.0 to 0.20.0:
+ 0.20.0 to 0.21.0:
.
- * Removed the modules - Wumpus.Extra.SafeFonts,
- Wumpus.Extra.SVGColours, Wumpus.Extra.X11Colours - they are
- now in the package @wumpus-basic@.
+ * Removed the instances of the Affine transformation. They have
+ been replaced with special transformation functions:
+ @rotatePrimitive@, @scalePrimitive@, @translatePrimitive@.
+ As Primitives are not in an affine frame until they are lifted
+ to Pictures the affine instances had ill-conceived semantics.
.
- * Removed the example FontPic.hs to @wumpus-basic@.
+ * Due to changes to accommodate the new non-affine
+ transformations, many of the class obligations have changed
+ on the @unit@ of Pictures, Primitives, Bounding Boxes etc.
+ Generally many class contexts that previously required
+ Fractional and Ord on the unit have changed to Real and
+ Floating.
.
- * Renamed two functions in Core.BoundingBox - @trace@ changed
- to @traceBoundary@; @retrace@ changed to @retraceBoundary@.
+ * Removed demo/AffineTest04.hs - there is no longer a
+ @rotateAbout@ operation on Primitives as they do not exist
+ in an affine frame until they they are lifted to Pictures.
+ Added - Scaled.hs, Rotated.hs, Translated,hs.
.
- * Fixed bug with @picOver@, previously the zorder was wrong
- and the function was actually working as /picUnder/.
- .
- * Added @capHeight@ to FontSize - get the size of an upper
- case letter without ascenders of descenders.
+ * Removed the UndecidableInstances pragma from
+ Core.PictureInternal. It looks like Core.Geometry will always
+ need UndecidableInstances though.
.
- * Guide updated regarding the new package @wumpus-basic@.
+ * Removed the Ord superclass constriant from the @Stroke@ and
+ @Fill@ classes and derived operations (e.g. @zostroke@).
.
.
build-type: Simple
@@ -91,11 +99,13 @@
demo/AffineTest01.hs,
demo/AffineTest02.hs,
demo/AffineTest03.hs,
- demo/AffineTest04.hs,
demo/AffineTestBase.hs,
demo/LabelPic.hs,
demo/MultiPic.hs
demo/Picture.hs,
+ demo/Rotated.hs
+ demo/Scaled.hs
+ demo/Translated.hs
doc/Guide.pdf,
doc-src/Guide.lhs,
doc-src/Makefile,