wumpus-core 0.20.0 → 0.21.0
raw patch · 23 files changed
+707/−355 lines, 23 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Wumpus.Core.WumpusTypes: rotatePrimitive :: (Real u, Floating u) => Radian -> Primitive u -> Primitive u
+ Wumpus.Core.WumpusTypes: scalePrimitive :: (Num u) => u -> u -> Primitive u -> Primitive u
+ Wumpus.Core.WumpusTypes: translatePrimitive :: (Num u) => u -> u -> Primitive u -> Primitive u
+ Wumpus.Core.WumpusTypes: uniformScalePrimitive :: (Num u) => u -> Primitive u -> Primitive u
- Wumpus.Core.OutputPostScript: writeEPS :: (Fractional u, Ord u, PSUnit u) => FilePath -> TextEncoder -> Picture u -> IO ()
+ Wumpus.Core.OutputPostScript: writeEPS :: (Real u, Floating u, PSUnit u) => FilePath -> TextEncoder -> Picture u -> IO ()
- Wumpus.Core.OutputPostScript: writeEPS_latin1 :: (Fractional u, Ord u, PSUnit u) => FilePath -> Picture u -> IO ()
+ Wumpus.Core.OutputPostScript: writeEPS_latin1 :: (Real u, Floating u, PSUnit u) => FilePath -> Picture u -> IO ()
- Wumpus.Core.OutputPostScript: writePS :: (Fractional u, Ord u, PSUnit u) => FilePath -> TextEncoder -> [Picture u] -> IO ()
+ Wumpus.Core.OutputPostScript: writePS :: (Real u, Floating u, PSUnit u) => FilePath -> TextEncoder -> [Picture u] -> IO ()
- Wumpus.Core.OutputPostScript: writePS_latin1 :: (Fractional u, Ord u, PSUnit u) => FilePath -> [Picture u] -> IO ()
+ Wumpus.Core.OutputPostScript: writePS_latin1 :: (Real u, Floating u, PSUnit u) => FilePath -> [Picture u] -> IO ()
- Wumpus.Core.OutputSVG: writeSVG :: (Ord u, PSUnit u) => FilePath -> TextEncoder -> Picture u -> IO ()
+ Wumpus.Core.OutputSVG: writeSVG :: (Real u, Floating u, PSUnit u) => FilePath -> TextEncoder -> Picture u -> IO ()
- Wumpus.Core.OutputSVG: writeSVG_latin1 :: (Ord u, PSUnit u) => FilePath -> Picture u -> IO ()
+ Wumpus.Core.OutputSVG: writeSVG_latin1 :: (Real u, Floating u, PSUnit u) => FilePath -> Picture u -> IO ()
- Wumpus.Core.Picture: cstroke :: (Stroke t, Num u, Ord u) => t -> Path u -> Primitive u
+ Wumpus.Core.Picture: cstroke :: (Stroke t, Num u) => t -> Path u -> Primitive u
- Wumpus.Core.Picture: fill :: (Fill t, Num u, Ord u) => t -> Path u -> Primitive u
+ Wumpus.Core.Picture: fill :: (Fill t, Num u) => t -> Path u -> Primitive u
- Wumpus.Core.Picture: frame :: (Fractional u, Floating u, Ord u) => Primitive u -> Picture u
+ Wumpus.Core.Picture: frame :: (Real u, Floating u) => Primitive u -> Picture u
- Wumpus.Core.Picture: frameMulti :: (Fractional u, Floating u, Ord u) => [Primitive u] -> Picture u
+ Wumpus.Core.Picture: frameMulti :: (Real u, Floating u) => [Primitive u] -> Picture u
- Wumpus.Core.Picture: frameWithin :: (Fractional u, Floating u, Ord u) => Primitive u -> BoundingBox u -> Picture u
+ Wumpus.Core.Picture: frameWithin :: (Real u, Floating u) => Primitive u -> BoundingBox u -> Picture u
- Wumpus.Core.Picture: illustrateBounds :: (Floating u, Ord u) => DRGB -> Picture u -> Picture u
+ Wumpus.Core.Picture: illustrateBounds :: (Real u, Floating u) => DRGB -> Picture u -> Picture u
- Wumpus.Core.Picture: illustrateBoundsPrim :: (Floating u, Ord u) => DRGB -> Primitive u -> Picture u
+ Wumpus.Core.Picture: illustrateBoundsPrim :: (Real u, Floating u) => DRGB -> Primitive u -> Picture u
- Wumpus.Core.Picture: illustrateControlPoints :: (Floating u, Ord u) => DRGB -> Primitive u -> Picture u
+ Wumpus.Core.Picture: illustrateControlPoints :: (Real u, Floating u) => DRGB -> Primitive u -> Picture u
- Wumpus.Core.Picture: ostroke :: (Stroke t, Num u, Ord u) => t -> Path u -> Primitive u
+ Wumpus.Core.Picture: ostroke :: (Stroke t, Num u) => t -> Path u -> Primitive u
- Wumpus.Core.Picture: zcstroke :: (Num u, Ord u) => Path u -> Primitive u
+ Wumpus.Core.Picture: zcstroke :: (Num u) => Path u -> Primitive u
- Wumpus.Core.Picture: zfill :: (Num u, Ord u) => Path u -> Primitive u
+ Wumpus.Core.Picture: zfill :: (Num u) => Path u -> Primitive u
- Wumpus.Core.Picture: zostroke :: (Num u, Ord u) => Path u -> Primitive u
+ Wumpus.Core.Picture: zostroke :: (Num u) => Path u -> Primitive u
- Wumpus.Extra.PictureLanguage: multilabel :: (Fractional u, Floating u, Ord u, TextLabel t) => t -> u -> VAlign -> [String] -> Point2 u -> Picture u
+ Wumpus.Extra.PictureLanguage: multilabel :: (Real u, Floating u, TextLabel t) => t -> u -> VAlign -> [String] -> Point2 u -> Picture u
Files
- CHANGES +31/−2
- demo/AffineTest01.hs +10/−7
- demo/AffineTest02.hs +11/−7
- demo/AffineTest03.hs +10/−7
- demo/AffineTest04.hs +0/−99
- demo/AffineTestBase.hs +11/−4
- demo/LabelPic.hs +1/−1
- demo/MultiPic.hs +5/−2
- demo/Rotated.hs +70/−0
- demo/Scaled.hs +63/−0
- demo/Translated.hs +59/−0
- doc-src/Guide.lhs +15/−8
- doc/Guide.pdf binary
- src/Wumpus/Core.hs +1/−1
- src/Wumpus/Core/Geometry.hs +24/−2
- src/Wumpus/Core/OutputPostScript.hs +38/−29
- src/Wumpus/Core/OutputSVG.hs +82/−27
- src/Wumpus/Core/Picture.hs +19/−21
- src/Wumpus/Core/PictureInternal.hs +217/−115
- src/Wumpus/Core/VersionNumber.hs +1/−1
- src/Wumpus/Core/WumpusTypes.hs +12/−5
- src/Wumpus/Extra/PictureLanguage.hs +2/−2
- wumpus-core.cabal +25/−15
CHANGES view
@@ -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@.
demo/AffineTest01.hs view
@@ -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 }
demo/AffineTest02.hs view
@@ -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 }
demo/AffineTest03.hs view
@@ -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 }
− demo/AffineTest04.hs
@@ -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 - } -
demo/AffineTestBase.hs view
@@ -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) --
demo/LabelPic.hs view
@@ -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]
demo/MultiPic.hs view
@@ -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
+ demo/Rotated.hs view
@@ -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++
+ demo/Scaled.hs view
@@ -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++
+ demo/Translated.hs view
@@ -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+++
doc-src/Guide.lhs view
@@ -240,7 +240,13 @@ <g transform="matrix(1.0, 0.0, 0.0, 1.0, 10.0, 20.0)"> ... </g> \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 }
doc/Guide.pdf view
binary file changed (56223 → 56739 bytes)
src/Wumpus/Core.hs view
@@ -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+
src/Wumpus/Core/Geometry.hs view
@@ -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.
src/Wumpus/Core/OutputPostScript.hs view
@@ -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- }-
src/Wumpus/Core/OutputSVG.hs view
@@ -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
src/Wumpus/Core/Picture.hs view
@@ -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:
src/Wumpus/Core/PictureInternal.hs view
@@ -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.
src/Wumpus/Core/VersionNumber.hs view
@@ -22,4 +22,4 @@ wumpus_core_version :: (Int,Int,Int)-wumpus_core_version = (0,20,0)+wumpus_core_version = (0,21,0)
src/Wumpus/Core/WumpusTypes.hs view
@@ -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
src/Wumpus/Extra/PictureLanguage.hs view
@@ -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)
wumpus-core.cabal view
@@ -1,5 +1,5 @@ name: wumpus-core-version: 0.20.0+version: 0.21.0 license: BSD3 license-file: LICENSE copyright: Stephen Tetley <stephen.tetley@gmail.com>@@ -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,