wumpus-basic 0.13.0 → 0.14.0

raw patch · 111 files changed

+11962/−10938 lines, 111 filesdep ~containersdep ~wumpus-corePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: containers, wumpus-core

API changes (from Hackage documentation)

Files

• demo/ArrowCircuit.hs +18/−16
• demo/Arrowheads.hs +6/−6
• demo/ClipPic.hs +6/−7
• demo/ColourChartUtils.hs +2/−2
• demo/ColourCharts.hs +2/−2
• demo/Connectors.hs +6/−6
• demo/DotPic.hs +18/−15
• demo/DrawingCompo.hs +2/−3
• demo/FeatureModel.hs +17/−15
• demo/FontPic.hs +6/−6
• demo/LeftRightText.hs +103/−32
• demo/PetriNet.hs +51/−19
• demo/Symbols.hs +5/−5
• src/Wumpus/Basic/Arrows.hs +0/−28
• src/Wumpus/Basic/Arrows/Connectors.hs +0/−148
• src/Wumpus/Basic/Arrows/Tips.hs +0/−485
• src/Wumpus/Basic/Chains.hs +0/−29
• src/Wumpus/Basic/Chains/Base.hs +0/−161
• src/Wumpus/Basic/Chains/Derived.hs +0/−129
• src/Wumpus/Basic/Colour/SVGColours.hs +0/−625
• src/Wumpus/Basic/Colour/X11Colours.hs +0/−1282
• src/Wumpus/Basic/Dots/AnchorDots.hs +0/−244
• src/Wumpus/Basic/Dots/Marks.hs +0/−229
• src/Wumpus/Basic/DrawingComposition.hs +0/−458
• src/Wumpus/Basic/FontLoader/AfmLoader.hs +0/−62
• src/Wumpus/Basic/FontLoader/AfmParserBase.hs +0/−215
• src/Wumpus/Basic/FontLoader/AfmV2Parser.hs +0/−67
• src/Wumpus/Basic/FontLoader/AfmV4Dot1Parser.hs +0/−67
• src/Wumpus/Basic/FontLoader/Base.hs +0/−222
• src/Wumpus/Basic/FontLoader/GSFontMap.hs +0/−87
• src/Wumpus/Basic/FontLoader/GSLoader.hs +0/−63
• src/Wumpus/Basic/Graphic.hs +0/−43
• src/Wumpus/Basic/Graphic/Anchors.hs +0/−158
• src/Wumpus/Basic/Graphic/Base.hs +0/−232
• src/Wumpus/Basic/Graphic/ContextFunction.hs +0/−718
• src/Wumpus/Basic/Graphic/Drawing.hs +0/−124
• src/Wumpus/Basic/Graphic/DrawingContext.hs +0/−324
• src/Wumpus/Basic/Graphic/GlyphMetrics.hs +0/−110
• src/Wumpus/Basic/Graphic/GraphicOperations.hs +0/−399
• src/Wumpus/Basic/Graphic/GraphicTypes.hs +0/−441
• src/Wumpus/Basic/Graphic/Query.hs +0/−264
• src/Wumpus/Basic/Graphic/ScalingContext.hs +0/−191
• src/Wumpus/Basic/Graphic/TraceDrawing.hs +0/−329
• src/Wumpus/Basic/Kernel.hs +57/−0
• src/Wumpus/Basic/Kernel/Base/Anchors.hs +238/−0
• src/Wumpus/Basic/Kernel/Base/BaseDefs.hs +281/−0
• src/Wumpus/Basic/Kernel/Base/ContextFun.hs +541/−0
• src/Wumpus/Basic/Kernel/Base/DrawingContext.hs +152/−0
• src/Wumpus/Basic/Kernel/Base/GlyphMetrics.hs +117/−0
• src/Wumpus/Basic/Kernel/Base/QueryDC.hs +263/−0
• src/Wumpus/Basic/Kernel/Base/ScalingContext.hs +195/−0
• src/Wumpus/Basic/Kernel/Base/UpdateDC.hs +244/−0
• src/Wumpus/Basic/Kernel/Base/WrappedPrimitive.hs +149/−0
• src/Wumpus/Basic/Kernel/Geometry/Intersection.hs +172/−0
• src/Wumpus/Basic/Kernel/Geometry/Paths.hs +114/−0
• src/Wumpus/Basic/Kernel/Objects/AdvanceGraphic.hs +106/−0
• src/Wumpus/Basic/Kernel/Objects/BaseObjects.hs +191/−0
• src/Wumpus/Basic/Kernel/Objects/Bounded.hs +140/−0
• src/Wumpus/Basic/Kernel/Objects/Connector.hs +74/−0
• src/Wumpus/Basic/Kernel/Objects/Drawing.hs +563/−0
• src/Wumpus/Basic/Kernel/Objects/Graphic.hs +470/−0
• src/Wumpus/Basic/Kernel/Objects/TraceDrawing.hs +338/−0
• src/Wumpus/Basic/Monads/TurtleClass.hs +0/−91
• src/Wumpus/Basic/Monads/TurtleMonad.hs +0/−140
• src/Wumpus/Basic/Paths.hs +0/−31
• src/Wumpus/Basic/Paths/Base.hs +0/−529
• src/Wumpus/Basic/Paths/Connectors.hs +0/−206
• src/Wumpus/Basic/Paths/Construction.hs +0/−160
• src/Wumpus/Basic/Paths/ControlPoints.hs +0/−189
• src/Wumpus/Basic/Paths/RoundCorners.hs +0/−121
• src/Wumpus/Basic/SafeFonts.hs +0/−167
• src/Wumpus/Basic/Shapes.hs +0/−27
• src/Wumpus/Basic/Shapes/Base.hs +0/−226
• src/Wumpus/Basic/Shapes/Coordinate.hs +0/−136
• src/Wumpus/Basic/Shapes/Derived.hs +0/−372
• src/Wumpus/Basic/System/FontLoader/Afm.hs +82/−0
• src/Wumpus/Basic/System/FontLoader/Base/AfmParserBase.hs +210/−0
• src/Wumpus/Basic/System/FontLoader/Base/AfmV2Parser.hs +65/−0
• src/Wumpus/Basic/System/FontLoader/Base/AfmV4Dot1Parser.hs +63/−0
• src/Wumpus/Basic/System/FontLoader/Base/Datatypes.hs +178/−0
• src/Wumpus/Basic/System/FontLoader/Base/FontLoadMonad.hs +205/−0
• src/Wumpus/Basic/System/FontLoader/Base/GSFontMap.hs +108/−0
• src/Wumpus/Basic/System/FontLoader/GhostScript.hs +86/−0
• src/Wumpus/Basic/Text/LRText.hs +0/−239
• src/Wumpus/Basic/Utils/Intersection.hs +0/−171
• src/Wumpus/Basic/VersionNumber.hs +2/−2
• src/Wumpus/Drawing/Arrows.hs +28/−0
• src/Wumpus/Drawing/Arrows/Connectors.hs +149/−0
• src/Wumpus/Drawing/Arrows/Tips.hs +505/−0
• src/Wumpus/Drawing/Chains.hs +29/−0
• src/Wumpus/Drawing/Chains/Base.hs +161/−0
• src/Wumpus/Drawing/Chains/Derived.hs +129/−0
• src/Wumpus/Drawing/Colour/SVGColours.hs +625/−0
• src/Wumpus/Drawing/Colour/X11Colours.hs +1282/−0
• src/Wumpus/Drawing/Dots/AnchorDots.hs +280/−0
• src/Wumpus/Drawing/Dots/Marks.hs +238/−0
• src/Wumpus/Drawing/Paths.hs +31/−0
• src/Wumpus/Drawing/Paths/Base.hs +529/−0
• src/Wumpus/Drawing/Paths/Connectors.hs +206/−0
• src/Wumpus/Drawing/Paths/Construction.hs +160/−0
• src/Wumpus/Drawing/Paths/ControlPoints.hs +189/−0
• src/Wumpus/Drawing/Paths/RoundCorners.hs +120/−0
• src/Wumpus/Drawing/Shapes.hs +27/−0
• src/Wumpus/Drawing/Shapes/Base.hs +227/−0
• src/Wumpus/Drawing/Shapes/Coordinate.hs +141/−0
• src/Wumpus/Drawing/Shapes/Derived.hs +371/−0
• src/Wumpus/Drawing/Text/LRText.hs +399/−0
• src/Wumpus/Drawing/Text/SafeFonts.hs +167/−0
• src/Wumpus/Drawing/Turtle/TurtleClass.hs +91/−0
• src/Wumpus/Drawing/Turtle/TurtleMonad.hs +140/−0
• wumpus-basic.cabal +92/−63

@@ -8,14 +8,14 @@  module ArrowCircuit where -import Wumpus.Basic.Arrows-import Wumpus.Basic.FontLoader.AfmLoader-import Wumpus.Basic.FontLoader.GSLoader-import Wumpus.Basic.Graphic-import Wumpus.Basic.Paths -import Wumpus.Basic.SafeFonts-import Wumpus.Basic.Shapes-import Wumpus.Basic.Text.LRText+import Wumpus.Basic.Kernel+import Wumpus.Basic.System.FontLoader.Afm+import Wumpus.Basic.System.FontLoader.GhostScript+import Wumpus.Drawing.Arrows+import Wumpus.Drawing.Paths +import Wumpus.Drawing.Shapes+import Wumpus.Drawing.Text.LRText+import Wumpus.Drawing.Text.SafeFonts  import Wumpus.Core                      -- package: wumpus-core @@ -40,7 +40,8 @@ makeGSPicture :: FilePath -> IO () makeGSPicture font_dir = do      putStrLn "Using GhostScript metrics..."-    base_metrics <- loadGSMetrics font_dir ["Times-Roman", "Times-Italic"]+    (base_metrics, msgs) <- loadGSMetrics font_dir ["Times-Roman", "Times-Italic"]+    mapM_ putStrLn msgs     let pic1 = runDrawingU (makeCtx base_metrics) circuit_drawing     writeEPS "./out/arrow_circuit01.eps" pic1     writeSVG "./out/arrow_circuit01.svg" pic1 @@ -48,14 +49,15 @@ makeAfmPicture :: FilePath -> IO () makeAfmPicture font_dir = do      putStrLn "Using AFM 4.1 metrics..."-    base_metrics <- loadAfmMetrics font_dir ["Times-Roman", "Times-Italic"]+    (base_metrics, msgs) <- loadAfmMetrics font_dir ["Times-Roman", "Times-Italic"]+    mapM_ putStrLn msgs     let pic1 = runDrawingU (makeCtx base_metrics) circuit_drawing     writeEPS "./out/arrow_circuit02.eps" pic1     writeSVG "./out/arrow_circuit02.svg" pic1    -makeCtx :: BaseGlyphMetrics -> DrawingContext-makeCtx = fontface times_roman . metricsContext 11+makeCtx :: GlyphMetrics -> DrawingContext+makeCtx = fontFace times_roman . metricsContext 11   @@ -93,7 +95,7 @@             , Real u, Floating u, FromPtSize u )           => ConnectorPath u -> Point2 u -> Point2 u -> m () connWith con p0 p1 = localize doublesize $ -    drawi_ $ situ2 (strokeConnector (rightArrow con tri45)) p0 p1+    drawi_ $ apply2R2 (strokeConnector (rightArrow con tri45)) p0 p1   atext :: ( CenterAnchor t, DUnit t ~ u@@ -101,11 +103,11 @@          , TraceM m, DrawingCtxM m, u ~ MonUnit m )       => t -> String -> m () atext ancr ss = let pt = center ancr in-   drawi_ $ singleLineCC ss `at` pt+   drawi_ $ ctrCenterLine ss `at` pt   ptext :: ( Real u, Floating u, FromPtSize u          , TraceM m, DrawingCtxM m, u ~ MonUnit m )       => Point2 u -> String -> m ()-ptext pt ss = localize (fontsize 14 . fontface times_italic) $ -    drawi_ $ singleLineCC ss `at` pt+ptext pt ss = localize (fontAttr times_italic 14) $ +    drawi_ $ ctrCenterLine ss `at` pt

@@ -3,11 +3,11 @@ module Arrowheads where  -import Wumpus.Basic.Arrows-import Wumpus.Basic.Chains-import Wumpus.Basic.Colour.SVGColours-import Wumpus.Basic.Graphic-import Wumpus.Basic.Paths hiding ( length )+import Wumpus.Basic.Kernel+import Wumpus.Drawing.Arrows+import Wumpus.Drawing.Chains+import Wumpus.Drawing.Colour.SVGColours+import Wumpus.Drawing.Paths hiding ( length )  import Wumpus.Core                              -- package: wumpus-core @@ -75,7 +75,7 @@                  => (Arrowhead u, Arrowhead u) -> Point2 u                   -> TraceDrawing u () makeArrowDrawing (arrl,arrr) p0 = -    drawi_ $ situ2 (strokeConnector (leftrightArrow connLine arrl arrr)) p0 p1+    drawi_ $ apply2R2 (strokeConnector (leftrightArrow connLine arrl arrr)) p0 p1   where     p1 = p0 .+^ hvec 100   

@@ -12,12 +12,11 @@  module ClipPic where -import Wumpus.Basic.Chains-import Wumpus.Basic.Colour.SVGColours-import Wumpus.Basic.DrawingComposition-import Wumpus.Basic.Graphic-import Wumpus.Basic.Paths-import Wumpus.Basic.SafeFonts+import Wumpus.Basic.Kernel+import Wumpus.Drawing.Chains+import Wumpus.Drawing.Colour.SVGColours+import Wumpus.Drawing.Paths+import Wumpus.Drawing.Text.SafeFonts  import Wumpus.Core                              -- package: wumpus-core @@ -76,7 +75,7 @@ iheartHaskell :: Num u => FromPtSize u => Point2 u -> TraceDrawing u ()  iheartHaskell pt = do     draw $ textline "I Haskell" `at` pt-    draw $ localize (fontface symbol) $ textline "&heart;" `at` (pt .+^ hvec 7)+    draw $ localize (fontFace symbol) $ textline "&heart;" `at` (pt .+^ hvec 7)   path01 :: Floating u => Path u

@@ -22,8 +22,8 @@    ) where -import qualified Wumpus.Basic.Colour.SVGColours    as SVG-import qualified Wumpus.Basic.Colour.X11Colours    as X11+import qualified Wumpus.Drawing.Colour.SVGColours    as SVG+import qualified Wumpus.Drawing.Colour.X11Colours    as X11  import Wumpus.Core.Colour ( RGBi ) 

@@ -4,8 +4,8 @@  import ColourChartUtils -import Wumpus.Basic.Chains-import Wumpus.Basic.Graphic+import Wumpus.Basic.Kernel+import Wumpus.Drawing.Chains  import Wumpus.Core                              -- package: wumpus-core 

@@ -3,11 +3,11 @@ module Connectors where  -import Wumpus.Basic.Arrows-import Wumpus.Basic.Chains-import Wumpus.Basic.Colour.SVGColours-import Wumpus.Basic.Graphic-import Wumpus.Basic.Paths hiding ( length )+import Wumpus.Basic.Kernel+import Wumpus.Drawing.Arrows+import Wumpus.Drawing.Chains+import Wumpus.Drawing.Colour.SVGColours+import Wumpus.Drawing.Paths hiding ( length )  import Wumpus.Core                              -- package: wumpus-core @@ -67,7 +67,7 @@ makeConnDrawing :: (Real u, Floating u, FromPtSize u)                   => ConnectorPath u -> Point2 u -> TraceDrawing u () makeConnDrawing conn p0 = -    drawi_ $ situ2 (strokeConnector (dblArrow conn curveTip)) p0 p1+    drawi_ $ connect (strokeConnector (dblArrow conn curveTip)) p0 p1   where     p1 = p0 .+^ vec 100 40   

@@ -3,13 +3,13 @@ module DotPic where  -import Wumpus.Basic.Chains-import Wumpus.Basic.Colour.SVGColours-import Wumpus.Basic.Dots.AnchorDots-import Wumpus.Basic.FontLoader.AfmLoader-import Wumpus.Basic.FontLoader.GSLoader-import Wumpus.Basic.Graphic-import Wumpus.Basic.SafeFonts+import Wumpus.Basic.Kernel+import Wumpus.Basic.System.FontLoader.Afm+import Wumpus.Basic.System.FontLoader.GhostScript+import Wumpus.Drawing.Chains+import Wumpus.Drawing.Colour.SVGColours+import Wumpus.Drawing.Dots.AnchorDots+import Wumpus.Drawing.Text.SafeFonts  import FontLoaderUtils @@ -36,24 +36,26 @@ makeGSPicture :: FilePath -> IO () makeGSPicture font_dir = do      putStrLn "Using GhostScript metrics..."-    base_metrics <- loadGSMetrics font_dir ["Helvetica"]+    (base_metrics, msgs) <- loadGSMetrics font_dir ["Helvetica"]+    mapM_ putStrLn msgs     let pic1 = runDrawingU (makeCtx base_metrics) dot_drawing -    writeEPS "./out/dots01.eps" pic1-    writeSVG "./out/dots01.svg" pic1+    writeEPS "./out/dots01_gs.eps" pic1+    writeSVG "./out/dots01_gs.svg" pic1     makeAfmPicture :: FilePath -> IO () makeAfmPicture font_dir = do      putStrLn "Using AFM 4.1 metrics..."-    base_metrics <- loadAfmMetrics font_dir ["Helvetica"]+    (base_metrics, msgs) <- loadAfmMetrics font_dir ["Helvetica"]+    mapM_ putStrLn msgs     let pic1 = runDrawingU (makeCtx base_metrics) dot_drawing -    writeEPS "./out/dots02.eps" pic1-    writeSVG "./out/dots02.svg" pic1+    writeEPS "./out/dots01_afm.eps" pic1+    writeSVG "./out/dots01_afm.svg" pic1   -makeCtx :: BaseGlyphMetrics -> DrawingContext-makeCtx = fillColour peru . fontface helvetica . metricsContext 24+makeCtx :: GlyphMetrics -> DrawingContext+makeCtx = fillColour peru . fontFace helvetica . metricsContext 24   dot_drawing :: Drawing Double@@ -75,6 +77,7 @@     , dotFOCross     , dotFDiamond     , dotText "%" +    , dotTriangle     ]  

@@ -2,9 +2,8 @@  module DrawingCompo where -import Wumpus.Basic.Colour.SVGColours-import Wumpus.Basic.DrawingComposition-import Wumpus.Basic.Graphic+import Wumpus.Basic.Kernel+import Wumpus.Drawing.Colour.SVGColours  import Wumpus.Core                              -- package: wumpus-core 

@@ -5,14 +5,14 @@  module FeatureModel where -import Wumpus.Basic.Arrows-import Wumpus.Basic.FontLoader.AfmLoader-import Wumpus.Basic.FontLoader.GSLoader-import Wumpus.Basic.Graphic-import Wumpus.Basic.Paths -import Wumpus.Basic.SafeFonts-import Wumpus.Basic.Shapes-import Wumpus.Basic.Text.LRText+import Wumpus.Basic.Kernel+import Wumpus.Basic.System.FontLoader.Afm+import Wumpus.Basic.System.FontLoader.GhostScript+import Wumpus.Drawing.Arrows+import Wumpus.Drawing.Paths +import Wumpus.Drawing.Shapes+import Wumpus.Drawing.Text.LRText+import Wumpus.Drawing.Text.SafeFonts  import Wumpus.Core                      -- package: wumpus-core @@ -35,7 +35,8 @@ makeGSPicture :: FilePath -> IO () makeGSPicture font_dir = do      putStrLn "Using GhostScript metrics..."-    base_metrics <- loadGSMetrics font_dir ["Courier-Bold"]+    (base_metrics, msgs) <- loadGSMetrics font_dir ["Courier-Bold"]+    mapM_ putStrLn msgs     let pic1 = runDrawingU (makeCtx base_metrics) feature_model      writeEPS "./out/feature_model01.eps" pic1     writeSVG "./out/feature_model01.svg" pic1 @@ -43,13 +44,14 @@ makeAfmPicture :: FilePath -> IO () makeAfmPicture font_dir = do      putStrLn "Using AFM 4.1 metrics..."-    base_metrics <- loadAfmMetrics font_dir ["Courier-Bold"]+    (base_metrics, msgs) <- loadAfmMetrics font_dir ["Courier-Bold"]+    mapM_ putStrLn msgs     let pic1 = runDrawingU (makeCtx base_metrics) feature_model      writeEPS "./out/feature_model02.eps" pic1     writeSVG "./out/feature_model02.svg" pic1  -makeCtx :: BaseGlyphMetrics -> DrawingContext-makeCtx = fontface courier_bold . metricsContext 18+makeCtx :: GlyphMetrics -> DrawingContext+makeCtx = fontFace courier_bold . metricsContext 18   -- Note - I haven't worked out how to do @alternative@, @or@ and@@ -90,7 +92,7 @@         => u -> String -> Point2 u -> TraceDrawing u (Box u) makeBox w ss pt = do      a <- drawi $ strokedShape $ rectangle w 20 $ pt-    drawi_ $ singleLineCC ss `at` center a+    drawi_ $ ctrCenterLine ss `at` center a     return a  box :: (Real u, Floating u, FromPtSize u) @@ -105,10 +107,10 @@ connWith :: ( Real u, Floating u, FromPtSize u )           => Arrowhead u -> Box u -> Box u -> TraceDrawing u (Path u) connWith arrh b0 b1 = do-   lw <- lineWidth+   lw <- getLineWidth    let p0 = south b0    let p1 = northwards (realToFrac lw) b1-   drawi $ situ2 (strokeConnector (rightArrow connLine arrh)) p0 p1+   drawi $ apply2R2 (strokeConnector (rightArrow connLine arrh)) p0 p1  infixr 4 `cmandatory`, `coptional`, `cmandatory_`, `coptional_` 

@@ -2,11 +2,11 @@  module FontPic where -import Wumpus.Basic.Chains-import Wumpus.Basic.Graphic-import Wumpus.Basic.Colour.SVGColours ( steel_blue )-import Wumpus.Basic.Colour.X11Colours ( indian_red1 )-import Wumpus.Basic.SafeFonts+import Wumpus.Basic.Kernel+import Wumpus.Drawing.Chains+import Wumpus.Drawing.Colour.SVGColours ( steel_blue )+import Wumpus.Drawing.Colour.X11Colours ( indian_red1 )+import Wumpus.Drawing.Text.SafeFonts  import Wumpus.Core                              -- package: wumpus-core @@ -44,7 +44,7 @@ makeLabel :: RGBi -> FontFace -> Int -> DLocGraphic makeLabel rgb ff sz = localize upd (textline $ fontMsg ff sz)   where-    upd = fillColour rgb . fontsize sz . fontface ff+    upd = fillColour rgb . fontAttr ff sz   -- indian_red1 -- steel_blue

@@ -16,13 +16,13 @@ module LeftRightText where  -import Wumpus.Basic.Colour.SVGColours-import Wumpus.Basic.Dots.Marks-import Wumpus.Basic.FontLoader.GSLoader-import Wumpus.Basic.FontLoader.AfmLoader-import Wumpus.Basic.Graphic-import Wumpus.Basic.SafeFonts-import Wumpus.Basic.Text.LRText+import Wumpus.Basic.Kernel+import Wumpus.Basic.System.FontLoader.Afm+import Wumpus.Basic.System.FontLoader.GhostScript+import Wumpus.Drawing.Colour.SVGColours+import Wumpus.Drawing.Dots.Marks+import Wumpus.Drawing.Text.LRText+import Wumpus.Drawing.Text.SafeFonts  import FontLoaderUtils @@ -47,56 +47,110 @@ makeGSPicture :: FilePath -> IO () makeGSPicture font_dir = do     putStrLn "Using GhostScript metrics..."-    gs_metrics <- loadGSMetrics font_dir ["Helvetica"]+    (gs_metrics, msgs) <- loadGSMetrics font_dir ["Helvetica"]+    mapM_ putStrLn msgs     let pic1 = runDrawingU (makeCtx gs_metrics) text_drawing -    writeEPS "./out/new_text01.eps" pic1-    writeSVG "./out/new_text01.svg" pic1+    writeEPS "./out/lr_text01.eps" pic1+    writeSVG "./out/lr_text01.svg" pic1  makeAfmPicture :: FilePath -> IO () makeAfmPicture font_dir = do     putStrLn "Using AFM 4.1 metrics..."-    afm_metrics <- loadAfmMetrics font_dir ["Helvetica"]+    (afm_metrics, msgs) <- loadAfmMetrics font_dir ["Helvetica"]+    mapM_ putStrLn msgs     let pic2 = runDrawingU (makeCtx afm_metrics) text_drawing -    writeEPS "./out/new_text02.eps" pic2-    writeSVG "./out/new_text02.svg" pic2+    writeEPS "./out/lr_text02.eps" pic2+    writeSVG "./out/lr_text02.svg" pic2    -makeCtx :: BaseGlyphMetrics -> DrawingContext-makeCtx = fontface helvetica . metricsContext 18+makeCtx :: GlyphMetrics -> DrawingContext+makeCtx = fontFace helvetica . metricsContext 18   text_drawing :: Drawing Double text_drawing = drawTracing $ do -    drawi_ $ (fn left_text)   `at` P2   0 100-    drawi_ $ (fn center_text) `at` P2 200 100-    drawi_ $ (fn right_text)  `at` P2 400 100-    drawi_ $ (fn blank_text)  `at` P2   0   0-    drawi_ $ (fn bl_oneline)  `at` P2 200   0-    drawi_ $ (fn cc_oneline)  `at` P2 400   0-    -    draw $ redPlus            `at` P2   0 100-    draw $ redPlus            `at` P2 200 100-    draw $ redPlus            `at` P2 400 100-    draw $ redPlus            `at` P2   0   0  -    draw $ redPlus            `at` P2 200   0 -    draw $ redPlus            `at` P2 400   0 -       +    drawi_ $ (fn left_text)       `at` P2   0 400+    drawi_ $ (fn center_text)     `at` P2 200 400+    drawi_ $ (fn right_text)      `at` P2 400 400+    drawi_ $ (fn blank_text)      `at` P2   0 300+    drawi_ $ (fn bl_oneline)      `at` P2 200 300+    drawi_ $ (fn cc_oneline)      `at` P2 400 300+    drawi_ $ (fn newblr)          `at` P2   0 200+    drawi_ $ (fn newblc)          `at` P2 200 200+    drawi_ $ (fn newbll)          `at` P2 400 200+    drawi_ $ (fn rnewblr)         `at` P2   0 100+    drawi_ $ (fn rnewblc)         `at` P2 200 100+    drawi_ $ (fn rnewbll)         `at` P2 400 100+    drawi_ $ (fn rleft_text)      `at` P2   0 (-75)+    drawi_ $ (fn rcenter_text)    `at` P2 200 (-75)+    drawi_ $ (fn rright_text)     `at` P2 400 (-75)+      + +    draw $ redPlus            `at` P2   0 400+    draw $ redPlus            `at` P2 200 400+    draw $ redPlus            `at` P2 400 400+    draw $ redPlus            `at` P2   0 300  +    draw $ redPlus            `at` P2 200 300 +    draw $ redPlus            `at` P2 400 300 +    draw $ redPlus            `at` P2   0 200  +    draw $ redPlus            `at` P2 200 200 +    draw $ redPlus            `at` P2 400 200  +    draw $ redPlus            `at` P2   0 100  +    draw $ redPlus            `at` P2 200 100 +    draw $ redPlus            `at` P2 400 100 +    draw $ redPlus            `at` P2   0 (-75)+    draw $ redPlus            `at` P2 200 (-75)+    draw $ redPlus            `at` P2 400 (-75)+         where     fn = illustrateBoundedLocGraphic-+    redPlus :: (Fractional u, FromPtSize u) => LocGraphic u redPlus = localize (strokeColour red) markPlus ++newblc :: BoundedLocGraphic Double+newblc = +    localize (strokeColour dark_slate_gray) $ +        baseCenterLine "new baseline center"++newbll :: BoundedLocGraphic Double+newbll = +    localize (strokeColour dark_slate_gray) $ +        baseLeftLine "new baseline left"++newblr :: BoundedLocGraphic Double+newblr = +    localize (strokeColour dark_slate_gray) $ +        baseRightLine "new baseline right"+++rnewblc :: BoundedLocGraphic Double+rnewblc = +    localize (strokeColour dark_slate_gray) $ +        rbaseCenterLine "baseline center" `rot` (0.25*pi)++rnewbll :: BoundedLocGraphic Double+rnewbll = +    localize (strokeColour dark_slate_gray) $ +        rbaseLeftLine "baseline left" `rot` (0.25*pi)++rnewblr :: BoundedLocGraphic Double+rnewblr = +    localize (strokeColour dark_slate_gray) $ +        rbaseRightLine "baseline right" `rot` (0.25 * pi)++ bl_oneline :: BoundedLocGraphic Double bl_oneline = -    localize (strokeColour dark_slate_gray) $ singleLineBL "Baseline-left..."+    localize (strokeColour dark_slate_gray) $ baseLeftLine "Baseline-left..."   cc_oneline :: BoundedLocGraphic Double cc_oneline = -    localize (strokeColour dark_slate_gray) $ singleLineCC "Center-center..."+    localize (strokeColour dark_slate_gray) $ ctrCenterLine "Center-center..."  blank_text :: BoundedLocGraphic Double blank_text = @@ -115,6 +169,23 @@ center_text :: BoundedLocGraphic Double center_text =      localize (strokeColour dark_slate_gray) $ multiAlignCenter dummy_text+++rleft_text :: BoundedLocGraphic Double+rleft_text = +    localize (strokeColour dark_slate_gray) $ +        rmultiAlignLeft dummy_text `rot`   (0.25*pi)+++rright_text :: BoundedLocGraphic Double+rright_text = +    localize (strokeColour dark_slate_gray) $ +        rmultiAlignRight dummy_text `rot`  (0.25*pi)++rcenter_text :: BoundedLocGraphic Double+rcenter_text = +    localize (strokeColour dark_slate_gray) $ +        rmultiAlignCenter dummy_text `rot` (0.25*pi)   dummy_text :: String 

@@ -7,14 +7,19 @@  module PetriNet where -import Wumpus.Basic.Arrows-import Wumpus.Basic.Colour.SVGColours-import Wumpus.Basic.Graphic                     -- package: wumpus-basic-import Wumpus.Basic.Paths-import Wumpus.Basic.Shapes.Base-import Wumpus.Basic.Shapes.Derived-import Wumpus.Basic.SafeFonts+import Wumpus.Basic.Kernel+import Wumpus.Basic.System.FontLoader.Afm+import Wumpus.Basic.System.FontLoader.GhostScript+import Wumpus.Drawing.Arrows+import Wumpus.Drawing.Colour.SVGColours+import Wumpus.Drawing.Paths+import Wumpus.Drawing.Shapes.Base+import Wumpus.Drawing.Shapes.Derived+import Wumpus.Drawing.Text.SafeFonts+import Wumpus.Drawing.Text.LRText +import FontLoaderUtils+ import Wumpus.Core                              -- package: wumpus-core  @@ -22,15 +27,40 @@   + main :: IO () main = do +    (mb_gs, mb_afm) <- processCmdLine default_font_loader_help     createDirectoryIfMissing True "./out/"-    let pic1 = runDrawingU (standardContext 14) petri_net-    writeEPS "./out/petri_net.eps" pic1-    writeSVG "./out/petri_net.svg" pic1-    +    maybe gs_failk  makeGSPicture  $ mb_gs+    maybe afm_failk makeAfmPicture $ mb_afm+  where+    gs_failk  = putStrLn "No GhostScript font path supplied..."+    afm_failk = putStrLn "No AFM v4.1 font path supplied..." +makeGSPicture :: FilePath -> IO ()+makeGSPicture font_dir = do +    putStrLn "Using GhostScript metrics..."+    (base_metrics, msgs) <- loadGSMetrics font_dir ["Helvetica", "Helvetica-Bold"]+    mapM_ putStrLn msgs+    let pic1 = runDrawingU (makeCtx base_metrics) petri_net+    writeEPS "./out/petri_net01.eps" pic1+    writeSVG "./out/petri_net01.svg" pic1  +makeAfmPicture :: FilePath -> IO ()+makeAfmPicture font_dir = do +    putStrLn "Using AFM 4.1 metrics..."+    (base_metrics, msgs) <- loadAfmMetrics font_dir ["Helvetica", "Helvetica-Bold"]+    mapM_ putStrLn msgs+    let pic1 = runDrawingU (makeCtx base_metrics) petri_net+    writeEPS "./out/petri_net02.eps" pic1+    writeSVG "./out/petri_net02.svg" pic1 +++makeCtx :: GlyphMetrics -> DrawingContext+makeCtx = fontFace helvetica . metricsContext 14++ petri_net :: DDrawing petri_net = drawTracing $ do     pw     <- place 0 140@@ -95,32 +125,34 @@          , Real u, Floating u, FromPtSize u )        => Point2 u -> Point2 u -> m () connector' p0 p1 = -    drawi_ $ situ2 (strokeConnector (rightArrow connLine tri45)) p0 p1+    drawi_ $ apply2R2 (strokeConnector (rightArrow connLine tri45)) p0 p1   connectorC :: ( Real u, Floating u, FromPtSize u              , DrawingCtxM m, TraceM m, u ~ MonUnit m )            => u -> Point2 u -> Point2 u -> m () connectorC v p0 p1 = -    drawi_ $ situ2 (strokeConnector (rightArrow (connRightVHV v) tri45)) p0 p1+    drawi_ $ apply2R2 (strokeConnector (rightArrow (connRightVHV v) tri45)) p0 p1  connectorD :: ( Real u, Floating u, FromPtSize u              , DrawingCtxM m, TraceM m, u ~ MonUnit m )            => u -> Point2 u -> Point2 u -> m () connectorD u p0 p1 = -    drawi_ $ situ2 (strokeConnector (rightArrow (connIsosceles u) tri45)) p0 p1+    drawi_ $ apply2R2 (strokeConnector (rightArrow (connIsosceles u) tri45)) p0 p1   lblParensParens :: Num u => LocGraphic u-lblParensParens = localize (fontface helvetica) $ textline "(),()"+lblParensParens = localize (fontFace helvetica) $ textline "(),()"  lblParensParensParens :: Num u => LocGraphic u-lblParensParensParens = localize (fontface helvetica) $ textline "(),(),()"+lblParensParensParens = localize (fontFace helvetica) $ textline "(),(),()"   lblBold' :: Num u => String -> LocGraphic u-lblBold' ss = localize (fontface helvetica_bold) $ textline ss+lblBold' ss = localize (fontFace helvetica_bold) $ textline ss  -lblBold :: (Fractional u, Ord u, FromPtSize u) => String -> LocGraphic u-lblBold ss = localize (fontface helvetica_bold) $ centermonoTextline ss+lblBold :: (Real u, Floating u, FromPtSize u) => String -> LocGraphic u+lblBold ss = localize (fontFace helvetica_bold) $ post $ ctrCenterLine ss+  where+    post = fmap (replaceL uNil)

@@ -2,9 +2,9 @@  module Symbols where -import Wumpus.Basic.Chains-import Wumpus.Basic.Graphic-import Wumpus.Basic.SafeFonts+import Wumpus.Basic.Kernel+import Wumpus.Drawing.Chains+import Wumpus.Drawing.Text.SafeFonts   import Wumpus.Core                              -- package: wumpus-core@@ -25,7 +25,7 @@   std_ctx :: DrawingContext-std_ctx = fontface times_roman $ standardContext 12+std_ctx = fontFace times_roman $ standardContext 12   -- Because the font changes, we draw the all the symbols in one@@ -35,7 +35,7 @@ -- symbols :: DDrawing symbols = drawTracing $ do-    localize (fontface symbol) $ zipWithM_ sdraw all_letters ps+    localize (fontFace symbol) $ zipWithM_ sdraw all_letters ps     zipWithM_ ldraw all_letters ps   where     sdraw (s,_)     pt = draw $ textline s `at` pt

@@ -1,28 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module      :  Wumpus.Basic.Arrows--- Copyright   :  (c) Stephen Tetley 2010--- License     :  BSD3------ Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable--- Portability :  GHC------ Shim module for arrow connectors and arrowheads.--- -----------------------------------------------------------------------------------module Wumpus.Basic.Arrows-  ( --    module Wumpus.Basic.Arrows.Tips-  , module Wumpus.Basic.Arrows.Connectors--  ) where--import Wumpus.Basic.Arrows.Tips-import Wumpus.Basic.Arrows.Connectors--

@@ -1,148 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module      :  Wumpus.Basic.Arrows.Connectors--- Copyright   :  (c) Stephen Tetley 2010--- License     :  BSD3------ Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable--- Portability :  GHC------ Draw arrows.--------------------------------------------------------------------------------------module Wumpus.Basic.Arrows.Connectors-  ( --    Connector-  , connector-  , leftArrow-  , rightArrow-  , dblArrow-  , leftrightArrow-  , strokeConnector---  ) where--import Wumpus.Basic.Arrows.Tips-import Wumpus.Basic.Graphic-import Wumpus.Basic.Paths--import Wumpus.Core                      -- package: wumpus-core--import Control.Applicative---- An arrowhead always know how to draw itself (filled triangle, --- stroked barb, etc.)------ A Path might will typically be drawn with openStroke,--- eventually there might be scope for drawing --- e.g. parallel lines  ====------- A ConnectorPath gets wrapped with how it is drawn into--- another type.---data Connector u = Connector -      { connector_path  :: ConnectorPath u-      , opt_left_arrow  :: Maybe (Arrowhead u)-      , opt_right_arrow :: Maybe (Arrowhead u)-      }----- | connector with no arrow heads.----connector :: ConnectorPath u -> Connector u-connector cp = -    Connector { connector_path  = cp-              , opt_left_arrow  = Nothing-              , opt_right_arrow = Nothing-              }--leftArrow :: ConnectorPath u -> Arrowhead u -> Connector u-leftArrow cp la =-    Connector { connector_path  = cp-              , opt_left_arrow  = Just la-              , opt_right_arrow = Nothing-              }---rightArrow :: ConnectorPath u -> Arrowhead u -> Connector u-rightArrow cp ra = -    Connector { connector_path  = cp-              , opt_left_arrow  = Nothing-              , opt_right_arrow = Just ra-              }---- | Same tip both ends.----dblArrow :: ConnectorPath u -> Arrowhead u -> Connector u-dblArrow cp arw = leftrightArrow cp arw arw--leftrightArrow :: ConnectorPath u -> Arrowhead u -> Arrowhead u -> Connector u-leftrightArrow cp la ra =-    Connector { connector_path  = cp-              , opt_left_arrow  = Just la-              , opt_right_arrow = Just ra-              }----strokeConnector :: (Real u, Floating u) -                => Connector u -> ConnectorImage u (Path u)-strokeConnector (Connector cpF opt_la opt_ra) =-    promote2 $ \p0 p1 -> let pathc = cpF p0 p1 in -       tipEval opt_la p0 (directionL pathc) >>= \(dl,gfL) -> -       tipEval opt_ra p1 (directionR pathc) >>= \(dr,gfR) ->-       intoImage (pure pathc) (postpro (gfR . gfL) $ drawP $ shortenPath dl dr pathc) -  where-    drawP       = openStroke . toPrimPath   ----- for Paths.Base ?----shortenPath :: (Real u , Floating u) => u  -> u -> Path u -> Path u-shortenPath l r = shortenL l .  shortenR r --type ArrowMark u = PrimGraphic u -> PrimGraphic u----- 'tipEval' is a bit of an oddity. It has to evaluate the --- Arrowhead / Image in the DrawingCtx to get the retract --- distance. But doing so evaluates the tips to PrimGraphics, thus --- it has to wrap the tips back up as Graphics with @pure@ so they --- can be concatenated to the drawn path as GraphicTrafos.------ The Arrowhead type could be changed, so rather than returning --- an Image (retract_distance, PrimGraphic) it returns --- (retract_distance, GraphicTrafo) but that would burden all --- arrowheads with some extra complexity.--- --- In short - the code here works but it isn\'t exemplary, and it --- doesn\'t show whether or not GraphicTrafo is a valuable type or--- if it is implemented correctly (as GraphicTrafo could having--- different implementations according to how it regards the --- DrawingCtx).-----tipEval :: Num u -        => Maybe (Arrowhead u) -> Point2 u -> Radian-        -> CF (u, ArrowMark u)-tipEval Nothing    _  _     = return (0,unmarked)-tipEval (Just arw) pt theta = makeMark $ unCF2 pt theta (getArrowhead arw)---unmarked :: ArrowMark u-unmarked = id---makeMark :: Image u a -> CF (a, ArrowMark u)-makeMark = postpro (\(a,prim) -> (a, superior prim))---

@@ -1,485 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module      :  Wumpus.Basic.Arrows.Tips--- Copyright   :  (c) Stephen Tetley 2010--- License     :  BSD3------ Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable--- Portability :  GHC------ Anchor points on shapes.------ \*\* WARNING \*\* this module is an experiment, and may --- change significantly in future revisions.--- -----------------------------------------------------------------------------------module Wumpus.Basic.Arrows.Tips-  ( ---    Arrowhead(..)-- -  , tri90-  , tri60-  , tri45-  , otri90-  , otri60-  , otri45--  , revtri90-  , revtri60-  , revtri45-  , orevtri90-  , orevtri60-  , orevtri45--  , barb90-  , barb60-  , barb45-  , revbarb90-  , revbarb60-  , revbarb45--  , perp--  , bracket--  , diskTip-  , odiskTip-  , squareTip-  , osquareTip-  , diamondTip-  , odiamondTip--  , curveTip-  , revcurveTip--  ) where--import Wumpus.Basic.Graphic-import Wumpus.Basic.Paths--import Wumpus.Core                      -- package: wumpus-core--import Data.AffineSpace                 -- package: vector-space--import Control.Applicative----- | Encode an arrowhead as an image where the /answer/ is the--- retract distance.------ The retract distance is context sensitive - usually just on--- the markHeight (or halfMarkHeight) so it has to be calculated--- w.r.t. the DrawingCtx.----newtype Arrowhead u = Arrowhead { getArrowhead :: LocThetaImage u u }------- | Tiplen is length of the tip \*along the line it follows\*. ------ > |\--- > | \--- > | /--- > |/--- > --- > |  |  -- tip len------- | Tip width is the distance between upper and lower --- arrow points.------ >       __--- > |\    --- > | \   tip--- > | /   width--- > |/    __--- >       ------ | This one is for triangular tips defined by their tip angle--- e.g. 90deg, 60deg, 45deg.------ The tip width will be variable (tip length should be the --- markHeight).--- -triVecsByAngle :: Floating u => u -> Radian -> Radian -> (Vec2 u, Vec2 u)-triVecsByAngle tiplen halfang theta = (vec_to_upper, vec_to_lower)-  where-    hypo_len     = tiplen / (fromRadian $ cos halfang)-    rtheta       = pi + theta        -- theta in the opposite direction-    vec_to_upper = avec (circularModulo $ rtheta - halfang) hypo_len-    vec_to_lower = avec (circularModulo $ rtheta + halfang) hypo_len ------ | This one is for triangles when the tip height and tip width--- are known.----triVecsByDist  :: (Real u, Floating u) -               => u -> u -> Radian -> (Vec2 u, Vec2 u)-triVecsByDist tiplen half_tipwidth theta = (vec_to_upper, vec_to_lower)-  where-    hypo_len     = sqrt $ (tiplen*tiplen) + (half_tipwidth*half_tipwidth)-    halfang      = toRadian $ atan (half_tipwidth / tiplen) -    rtheta       = pi + theta        -- theta in the opposite direction-    vec_to_upper = avec (circularModulo $ rtheta - halfang) hypo_len-    vec_to_lower = avec (circularModulo $ rtheta + halfang) hypo_len -----{--markHeightPlusLineWidth :: (Fractional u, FromPtSize u) => DrawingR u-markHeightPlusLineWidth = -    (\h lw -> h + realToFrac lw) <$> markHeight <*> lineWidth--}---markHeightLessLineWidth :: (Fractional u, FromPtSize u) => CF u-markHeightLessLineWidth = -    (\h lw -> h - realToFrac lw) <$> markHeight <*> lineWidth----- noRetract ignores both the angle and the point.------ Its common for the rectraction not to care about the angle or --- the point and only care about the DrawingCtx.----noRetract :: Num u => LocThetaCF u u-noRetract = wrap2 0 ------------------------------------------------------------------------------------------- | Tripoints takes the \*tip length\* is the mark height.------ This means that the 90deg tip has a tip width greater-than the--- mark height (but that is okay - seemingly this is how TikZ --- does it).----tripointsByAngle :: (Floating u, FromPtSize u)-                 => Radian ->  LocThetaCF u (Point2 u, Point2 u)-tripointsByAngle triang = markHeight >>= \h -> -    raise2 $ \pt theta -> let (vup,vlo) = triVecsByAngle h (0.5*triang) theta-                          in  (pt .+^ vup, pt .+^ vlo)-    --revtripointsByAngle :: (Floating u, FromPtSize u)-                    => Radian -                    -> LocThetaCF u (Point2 u, Point2 u, Point2 u)-revtripointsByAngle triang = markHeight >>= \h -> -    raise2 $ \pt theta -> let theta'    = circularModulo $ pi+theta -                              (vup,vlo) = triVecsByAngle h (0.5*triang) theta'-                              back_tip  = pt .-^ avec theta h -                          in (back_tip .+^ vup, back_tip, back_tip .+^ vlo)----tripointsByDist :: (Real u, Floating u, FromPtSize u)-                => LocThetaCF u (Point2 u, Point2 u)-tripointsByDist = markHeight >>= \h ->-    raise2 $ \pt theta -> let (vup,vlo) = triVecsByDist h (0.5*h) theta-                          in  (pt .+^ vup, pt .+^ vlo)-  ---revtripointsByDist :: (Real u, Floating u, FromPtSize u)-                   => LocThetaCF u (Point2 u, Point2 u, Point2 u)-revtripointsByDist = markHeight >>= \h -> -    raise2 $ \pt theta -> let theta'    = circularModulo $ pi+theta -                              (vup,vlo) = triVecsByDist h (0.5*h) theta'-                              back_tip  = pt .-^ avec theta h -                          in  (back_tip .+^ vup, back_tip, back_tip .+^ vlo)-----bindLocTip :: LocThetaCF u a -> (a -> LocGraphic u) -> LocThetaGraphic u-bindLocTip df da = bind2 df (\a -> static2 $ da a) --bindLocThetaTip :: LocThetaCF u a -> (a -> LocThetaGraphic u) -                -> LocThetaGraphic u-bindLocThetaTip = bind2 ------ width = xchar_height--- filled with stroke colour!--triTLG :: (Floating u, Real u, FromPtSize u)-       => Radian -> (PrimPath u -> Graphic u) -> LocThetaGraphic u-triTLG triang drawF = localize bothStrokeColour $ -    bindLocTip (tripointsByAngle triang) -               (\(u,v) -> promote1 $ \pt -> drawF $ vertexPath [pt,u,v])----tri90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-tri90 = Arrowhead $ -    intoLocThetaImage (dblstatic markHeight) (triTLG (pi/2) filledPath)---tri60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-tri60 = Arrowhead $-    intoLocThetaImage (dblstatic markHeight) (triTLG (pi/3) filledPath)---tri45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-tri45 = Arrowhead $ -    intoLocThetaImage (dblstatic markHeight) (triTLG (pi/4) filledPath)--otri90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-otri90 = Arrowhead $-    intoLocThetaImage (dblstatic markHeight) (triTLG (pi/2) closedStroke)--otri60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-otri60 = Arrowhead $   -    intoLocThetaImage (dblstatic markHeight) (triTLG (pi/3) closedStroke)--otri45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-otri45 = Arrowhead $ -    intoLocThetaImage (dblstatic markHeight) (triTLG (pi/4) closedStroke)----- width = xchar_height--- filled with stroke colour!--revtriTLG :: (Floating u, Real u, FromPtSize u)-          => Radian -> (PrimPath u -> Graphic u) -> LocThetaGraphic u-revtriTLG triang drawF = localize bothStrokeColour $ -    bindLocTip (revtripointsByAngle triang) -               (\(u,pt,v) -> static1 $ drawF $ vertexPath [u,pt,v])----revtri90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-revtri90 = Arrowhead $ -    intoLocThetaImage (dblstatic markHeightLessLineWidth) -                      (revtriTLG (pi/2) filledPath)--revtri60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-revtri60 = Arrowhead $ -    intoLocThetaImage (dblstatic markHeightLessLineWidth) -                      (revtriTLG (pi/3) filledPath)--revtri45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-revtri45 = Arrowhead $ -    intoLocThetaImage (dblstatic markHeightLessLineWidth) -                      (revtriTLG (pi/4) filledPath)---orevtri90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-orevtri90 = Arrowhead $ -    intoLocThetaImage (dblstatic markHeightLessLineWidth) -                      (revtriTLG (pi/2) closedStroke)--orevtri60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-orevtri60 = Arrowhead $ -    intoLocThetaImage (dblstatic markHeightLessLineWidth) -                      (revtriTLG (pi/3) closedStroke)--orevtri45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-orevtri45 = Arrowhead $ -    intoLocThetaImage (dblstatic markHeightLessLineWidth) -                      (revtriTLG (pi/4) closedStroke)----barbTLG :: (Floating u, Real u, FromPtSize u) => Radian -> LocThetaGraphic u-barbTLG ang =  -    bindLocTip (tripointsByAngle ang) -               (\(u,v) -> promote1 $ \pt -> openStroke $ vertexPath [u,pt,v])----barb90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-barb90 = Arrowhead $ intoLocThetaImage noRetract (barbTLG (pi/2))--barb60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-barb60 = Arrowhead $ intoLocThetaImage noRetract (barbTLG (pi/3))---barb45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-barb45 = Arrowhead $ intoLocThetaImage noRetract (barbTLG (pi/4))----revbarbTLG :: (Floating u, Real u, FromPtSize u) => Radian -> LocThetaGraphic u-revbarbTLG ang = -    bindLocTip (revtripointsByAngle ang)-               (\(u,pt,v) -> static1 $ openStroke $ vertexPath [u,pt,v])--revbarb90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-revbarb90 = Arrowhead $ -    intoLocThetaImage (dblstatic markHeight) (revbarbTLG (pi/2))---revbarb60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-revbarb60 = Arrowhead $ -    intoLocThetaImage (dblstatic markHeight) (revbarbTLG (pi/3))--revbarb45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u-revbarb45 = Arrowhead $ -    intoLocThetaImage (dblstatic markHeight) (revbarbTLG (pi/4))---perpTLG :: (Floating u, FromPtSize u) => LocThetaGraphic u-perpTLG = bindLocThetaTip (dblstatic markHalfHeight) fn-  where-    fn hh = promote2 $ \pt theta -> openStroke $ perpPath hh pt theta---perpPath :: Floating u => u -> Point2 u -> Radian -> PrimPath u-perpPath hh ctr theta = primPath p0 [lineTo p1]-  where-    p0 = displacePerpendicular   hh  theta ctr-    p1 = displacePerpendicular (-hh) theta ctr -             ---perp :: (Floating u, FromPtSize u) => Arrowhead u-perp = Arrowhead $ intoLocThetaImage noRetract perpTLG----bracketTLG :: (Floating u, FromPtSize u) => LocThetaGraphic u-bracketTLG = bindLocThetaTip (dblstatic markHalfHeight) fn-  where-    fn hh = promote2 $ \pt theta -> openStroke $ bracketPath hh pt theta---bracketPath :: Floating u => u -> Point2 u -> Radian -> PrimPath u-bracketPath hh pt theta = vertexPath [p0,p1,p2,p3]-  where-    p1 = displacePerpendicular   hh  theta pt-    p0 = displaceParallel      (-hh) theta p1-    p2 = displacePerpendicular (-hh) theta pt-    p3 = displaceParallel      (-hh) theta p2-        ----bracket :: (Floating u, FromPtSize u) => Arrowhead u-bracket = Arrowhead $ intoLocThetaImage noRetract bracketTLG---diskTLG :: (Floating u, FromPtSize u) -        => (u -> Point2 u -> Graphic u) -> LocThetaGraphic u-diskTLG drawF = bindLocThetaTip (dblstatic markHalfHeight) fn -  where-   fn hh = promote2 $ \pt theta -> let ctr = pt .-^ avec theta hh-                                   in drawF hh ctr---diskTip :: (Floating u, FromPtSize u) => Arrowhead u-diskTip = Arrowhead $ intoLocThetaImage (dblstatic markHeight) (diskTLG drawF)-  where-    drawF r pt = localize bothStrokeColour $ filledDisk r `at` pt---odiskTip :: (Floating u, FromPtSize u) => Arrowhead u-odiskTip = Arrowhead $ intoLocThetaImage (dblstatic markHeight) (diskTLG drawF)-  where-    drawF r pt = strokedDisk r `at` pt---squareTLG :: (Floating u, FromPtSize u) -        => (PrimPath u -> Graphic u) -> LocThetaGraphic u-squareTLG drawF = bindLocThetaTip (dblstatic markHalfHeight) fn-  where-    fn hh = promote2 $ \pt theta -> -              let p0 = displacePerpendicular     hh  theta pt-                  p3 = displacePerpendicular   (-hh) theta pt-                  p1 = displaceParallel      (-2*hh) theta p0-                  p2 = displaceParallel      (-2*hh) theta p3-              in drawF $ vertexPath [p0,p1,p2,p3]---squareTip :: (Floating u, FromPtSize u) => Arrowhead u-squareTip = Arrowhead $ intoLocThetaImage (dblstatic markHeight) (squareTLG drawF)-  where-    drawF = localize bothStrokeColour . filledPath---osquareTip :: (Floating u, FromPtSize u) => Arrowhead u-osquareTip = Arrowhead $ -    intoLocThetaImage (dblstatic markHeight) (squareTLG closedStroke)---diamondTLG :: (Floating u, FromPtSize u) -           => (PrimPath u -> Graphic u) -> LocThetaGraphic u-diamondTLG drawF = bindLocThetaTip (dblstatic markHalfHeight) fn-  where-    fn hh = promote2 $ \pt theta -> -              let ctr = displaceParallel       (-2*hh) theta pt-                  p1  = displacePerpendicular     hh   theta ctr-                  p3  = displacePerpendicular   (-hh)  theta ctr-                  p2  = displaceParallel       (-4*hh) theta pt-              in drawF $ vertexPath [pt,p1,p2,p3]---diamondTip :: (Floating u, FromPtSize u) => Arrowhead u-diamondTip = Arrowhead $ -    intoLocThetaImage (dblstatic $ fmap (2*) markHeightLessLineWidth) -                      (diamondTLG drawF)-  where-    drawF = localize bothStrokeColour . filledPath---odiamondTip :: (Floating u, FromPtSize u) => Arrowhead u-odiamondTip = Arrowhead $ -    intoLocThetaImage (dblstatic $ fmap (2*) markHeight) (diamondTLG closedStroke)------ Note - points flipped to get the second trapezium to --- draw /underneath/.----curveTLG :: (Real u, Floating u, FromPtSize u) => LocThetaGraphic u-curveTLG = bindLocThetaTip (dblstatic markHalfHeight) fn-  where-    fn hh = promote2 $ \pt theta -> -              unLocTheta pt theta tripointsByDist >>= \(tup,tlo) -> -              let (u1,u2) = trapezoidFromBasePoints (0.25*hh) 0.5 pt tup-                  (l2,l1) = trapezoidFromBasePoints (0.25*hh) 0.5 tlo pt -                  tpath   = curve tup u2 u1 pt `append` curve pt l1 l2 tlo-              in localize (joinRound . capRound) -                          (openStroke $ toPrimPath $ tpath)---curveTip :: (Real u, Floating u, FromPtSize u) => Arrowhead u-curveTip = Arrowhead $ -    intoLocThetaImage (dblstatic $ fmap realToFrac lineWidth) curveTLG----- Note - points flipped to get the second trapezium to --- draw /underneath/.----revcurveTLG :: (Real u, Floating u, FromPtSize u) => LocThetaGraphic u-revcurveTLG = bindLocThetaTip (dblstatic markHalfHeight) fn -  where-   fn hh = promote2 $ \pt theta ->-             unLocTheta pt theta revtripointsByDist >>= \(tup,p1,tlo) -> -             let (u1,u2) = trapezoidFromBasePoints (0.25*hh) 0.5 p1 tup-                 (l2,l1) = trapezoidFromBasePoints (0.25*hh) 0.5 tlo p1-                 tpath   = curve tup u2 u1 p1 `append` curve p1 l1 l2 tlo-             in localize (joinRound . capRound) -                         (openStroke $ toPrimPath $ tpath)--revcurveTip :: (Real u, Floating u, FromPtSize u) => Arrowhead u-revcurveTip = Arrowhead $ -    intoLocThetaImage (dblstatic markHeight) revcurveTLG-

@@ -1,29 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module      :  Wumpus.Basic.Chains--- Copyright   :  (c) Stephen Tetley 2010--- License     :  BSD3------ Maintainer  :  stephen.tetley@gmail.com--- Stability   :  unstable--- Portability :  GHC ------ Shim module.------ WARNING - very unstable.--------------------------------------------------------------------------------------module Wumpus.Basic.Chains-  (-    module Wumpus.Basic.Chains.Base-  , module Wumpus.Basic.Chains.Derived-  --  ) where---import Wumpus.Basic.Chains.Base-import Wumpus.Basic.Chains.Derived

@@ -1,161 +0,0 @@-{-# LANGUAGE ExistentialQuantification  #-}-{-# LANGUAGE RankNTypes                 #-}-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module      :  Wumpus.Basic.Chains.Base--- Copyright   :  (c) Stephen Tetley 2010--- License     :  BSD3------ Maintainer  :  stephen.tetley@gmail.com--- Stability   :  unstable--- Portability :  GHC ------ Generate points in an iterated chain.------ WARNING - very unstable.--------------------------------------------------------------------------------------module Wumpus.Basic.Chains.Base-  (---    Chain-  , LocChain-  , chain-  , chainFrom-  , unchain---  , AnaAlg(..)-  , IterAlg(..)--  , BivariateAlg-  , bivariate-  -  , SequenceAlg-  , iteration--  , bounded-  , pairOnXs-  , pairOnYs--  ) where--import Wumpus.Basic.Graphic--import Wumpus.Core                              -- package: wumpus-core----- Chain uses the Scaling monad, but it is not itself a monad.---newtype Chain ux uy u = Chain { getChain :: Scaling ux uy u [Point2 u] }---type LocChain ux uy u = Point2 u -> Chain ux uy u----chain :: BivariateAlg ux uy -> Chain ux uy u-chain alg = Chain (scaledBivariatePt alg)--chainFrom :: Num u => BivariateAlg ux uy -> LocChain ux uy u-chainFrom alg start = Chain (scaledBivariateVec alg start)---unchain :: ScalingContext ux uy u -> Chain ux uy u -> [Point2 u]-unchain ctx ch = runScaling ctx $ getChain ch- ---- | Chains are built as unfolds - AnaAlg avoids the pair --- constructor in the usual definition of unfoldr and makes the--- state strict.------ It is expected that all Chains built on unfolds will terminate. ----data AnaAlg st a = Done | Step a !st----- | IterAlg is a variant of AnaAlg that builds infinite --- sequences (iterations).--- --- When lifted to a Chain an iteration is bounded by a count so--- it will terminate.----data IterAlg st a = IterStep a !st ---data BivariateAlg ux uy = forall st. BivariateAlg-      { st_zero     :: st-      , gen_step    :: st -> AnaAlg st (ux,uy)-      }--bivariate :: st -> (st -> AnaAlg st (ux,uy)) -> BivariateAlg ux uy-bivariate st0 step_alg = BivariateAlg { st_zero = st0-                                      , gen_step = step_alg }---scaledBivariatePt :: BivariateAlg ux uy -> Scaling ux uy u [Point2 u]-scaledBivariatePt (BivariateAlg { st_zero = st0, gen_step = step}) = -    go (step st0)   -  where-    go Done              = return []-    go (Step (x,y) next) = scalePt x y    >>= \pt   ->-                           go (step next) >>= \rest ->  -                           return  (pt:rest)---- Note - cannot encode this with (.+^) from Data.AffineSpace.--- The u (u ~ MonUnit m) extracted from the Scaling Context is --- not compatible with the u that forms Points (u ~ Diff (Point2 u)).--scaledBivariateVec :: Num u -                   => BivariateAlg ux uy -                   -> Point2 u -                   -> Scaling ux uy u [Point2 u]-scaledBivariateVec (BivariateAlg { st_zero = st0, gen_step = step}) (P2 x0 y0) = -    go (step st0)   -  where-    go Done              = return []-    go (Step (x,y) next) = scaleVec x y   >>= \(V2 dx dy)   ->-                           go (step next) >>= \rest ->  -                           return (P2 (x0+dx) (y0+dy):rest)---data SequenceAlg a = forall st. SequenceAlg-      { initial_st  :: st-      , iter_step   :: st -> IterAlg st a-      }--iteration :: (a -> a) -> a -> SequenceAlg a-iteration fn s0 = SequenceAlg { initial_st = s0, iter_step = step }-  where-    step s = IterStep s (fn s)---bounded :: Int -> SequenceAlg (ux,uy) -> BivariateAlg ux uy-bounded n (SequenceAlg a0 fn) =-    BivariateAlg { st_zero     = (0,a0)-                 , gen_step    = gstep  }-  where-    gstep (i,s) | i < n = let (IterStep ans next) = fn s in Step ans (i+1,next)-    gstep _             = Done-----pairOnXs :: (ux -> uy) -> SequenceAlg ux -> SequenceAlg (ux,uy)-pairOnXs fn (SequenceAlg { initial_st = s0, iter_step = step }) = -    SequenceAlg s0 step2-  where-    step2 s = let (IterStep a s') = step s in IterStep (a, fn a) s'---pairOnYs :: (r -> l) -> SequenceAlg r -> SequenceAlg (l,r) -pairOnYs fn (SequenceAlg { initial_st = s0, iter_step = step }) = -    SequenceAlg  s0 step2-  where-    step2 s = let (IterStep a s') = step s in IterStep (fn a, a) s'-

@@ -1,129 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module      :  Wumpus.Basic.Chains.Derived--- Copyright   :  (c) Stephen Tetley 2010--- License     :  BSD3------ Maintainer  :  stephen.tetley@gmail.com--- Stability   :  unstable--- Portability :  GHC ------ Generate points in an iterated chain.------ WARNING - very unstable.--------------------------------------------------------------------------------------module Wumpus.Basic.Chains.Derived-  (-    -    univariateX-  , univariateY--  , tableDown-  , tableRight--  , horizontal-  , vertical--  , horizontals-  , verticals--  , rescale--  ) where--import Wumpus.Basic.Chains.Base-----univariateX :: (Fractional uy, Num ux, Num u) -            => [ux] -> LocChain ux uy u-univariateX zs = chainFrom $ bivariate (0,zs) gstep-  where-    gstep (_,[])     = Done -    gstep (n,x:xs)   = Step (x,n) (n+i,xs)-    len              = length zs-    i                = rescale 0 1 0 (fromIntegral $ len-1) 1---univariateY :: (Fractional ux, Num uy, Num u) -            => [uy] -> LocChain ux uy u-univariateY zs = chainFrom $ bivariate (0,zs) gstep-  where-    gstep (_,[])     = Done -    gstep (n,y:ys)   = Step (n,y) (n+i,ys)-    len              = length zs-    i                = rescale 0 1 0 (fromIntegral $ len-1) 1--------------------------------------------------------------------------------------- Tables---tableDown :: Int -> Int -> Chain Int Int u-tableDown rows cols = -    chain $ bounded (rows*cols) (iteration (downstep rows) (0,rows-1))----downstep :: Int -> (Int,Int) -> (Int,Int)-downstep row_count (x,y) | y == 0 = (x+1,row_count-1)-downstep _         (x,y)          = (x,y-1)----tableRight :: Num u => Int -> Int -> Chain Int Int u-tableRight rows cols = -    chain $ bounded (rows*cols) (iteration (rightstep cols) (0,rows-1))---rightstep :: Int -> (Int,Int) -> (Int,Int)-rightstep col_count (x,y) | x == (col_count-1) = (0,y-1)-rightstep _         (x,y)                      = (x+1,y)---horizontal :: Int -> Chain Int Int u-horizontal count = chain $ bivariate 0 alg-  where-    alg st | st == count = Done-    alg st               = Step (st,0) (st+1)---vertical :: Int -> Chain Int Int u-vertical count = chain $ bivariate 0 alg-  where-    alg st | st == count = Done-    alg st               = Step (0,st) (st+1)----horizontals :: (Num ua, Num u) => [ua] -> LocChain ua ua u-horizontals xs0 = chainFrom $ bivariate xs0 alg-  where-    alg []     = Done-    alg (x:xs) = Step (x,0) xs---verticals :: (Num ua, Num u)  => [ua] -> LocChain ua ua u-verticals ys0 = chainFrom $ bivariate ys0 alg-  where-    alg []     = Done-    alg (y:ys) = Step (0,y) ys-------------------------------------------------------------------------------------- general helpers--rescale :: Fractional a => a -> a -> a -> a -> a -> a-rescale outmin outmax innmin innmax a = -    outmin + innpos * (outrange / innrange)  -  where-    outrange = outmax - outmin-    innrange = innmax - innmin-    innpos   = a - innmin -

@@ -1,625 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module      :  Wumpus.Basic.Colour.SVGColours--- Copyright   :  (c) Stephen Tetley 2009-2010--- License     :  BSD3------ Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  unstable--- Portability :  GHC------ The SVG \'named colours\', as rgb [0,1] values --------------------------------------------------------------------------------------module Wumpus.Basic.Colour.SVGColours -  (-    -  -- * Named colours-    alice_blue-  , antique_white-  , aqua-  , aquamarine-  , azure-  , beige-  , bisque-  , black-  , blanched_almond-  , blue-  , blue_violet-  , brown-  , burlywood-  , cadet_blue-  , chartreuse-  , chocolate-  , coral-  , cornflower_blue-  , cornsilk-  , crimson-  , cyan-  , dark_blue-  , dark_cyan-  , dark_goldenrod-  , dark_gray-  , dark_green-  , dark_grey-  , dark_khaki-  , dark_magenta-  , dark_olive_green-  , dark_orange-  , dark_orchid-  , dark_red-  , dark_salmon-  , dark_sea_green-  , dark_slate_blue-  , dark_slate_gray-  , dark_slate_grey-  , dark_turquoise-  , dark_violet-  , deep_pink-  , deep_sky_blue-  , dim_gray-  , dim_grey-  , dodger_blue-  , firebrick-  , floral_white-  , forest_green-  , fuchsia-  , gainsboro-  , ghost_white-  , gold-  , goldenrod-  , gray-  , grey-  , green-  , green_yellow-  , honeydew-  , hot_pink-  , indian_red-  , indigo-  , ivory-  , khaki-  , lavender-  , lavender_blush-  , lawn_green-  , lemon_chiffon-  , light_blue-  , light_coral-  , light_cyan-  , light_goldenrod_yellow-  , light_gray-  , light_green-  , light_grey-  , light_pink-  , light_salmon-  , light_sea_green-  , light_sky_blue-  , light_slate_gray-  , light_slate_grey-  , light_steel_blue-  , light_yellow-  , lime-  , lime_green-  , linen-  , magenta-  , maroon-  , medium_aquamarine-  , medium_blue-  , medium_orchid-  , medium_purple-  , medium_sea_green-  , medium_slate_blue-  , medium_spring_green-  , medium_turquoise-  , medium_violet_red-  , midnight_blue-  , mintcream-  , mistyrose-  , moccasin-  , navajo_white-  , navy-  , old_lace-  , olive-  , olive_drab-  , orange-  , orange_red-  , orchid-  , pale_goldenrod-  , pale_green-  , pale_turquoise-  , pale_violet_red-  , papaya_whip-  , peach_puff-  , peru-  , pink-  , plum-  , powder_blue-  , purple-  , red-  , rosy_brown-  , royal_blue-  , saddle_brown-  , salmon-  , sandy_brown-  , sea_green-  , seashell-  , sienna-  , silver-  , sky_blue-  , slate_blue-  , slate_gray-  , slate_grey-  , snow-  , spring_green-  , steel_blue-  , tan-  , teal-  , thistle-  , tomato-  , turquoise-  , violet-  , wheat-  , white-  , whitesmoke-  , yellow-  , yellow_green-  -  ) where---import Wumpus.Core.Colour ( RGBi(..) )---import Prelude ( )-  ------------------------------------------------------------------------------------  -alice_blue              :: RGBi-alice_blue              = RGBi 0xf0 0xf8 0xff--antique_white           :: RGBi -antique_white           = RGBi 0xfa 0xeb 0xd7--aqua                    :: RGBi-aqua                    = RGBi 0x00 0xff 0xff--aquamarine              :: RGBi-aquamarine              = RGBi 0x7f 0xff 0xd4--azure                   :: RGBi-azure                   = RGBi 0xf0 0xff 0xff--beige                   :: RGBi-beige                   = RGBi 0xf5 0xf5 0xdc--bisque                  :: RGBi-bisque                  = RGBi 0xff 0xe4 0xc4--black                   :: RGBi-black                   = RGBi 0x00 0x00 0x00--blanched_almond         :: RGBi-blanched_almond         = RGBi 0xff 0xeb 0xcd--blue                    :: RGBi-blue                    = RGBi 0x00 0x00 0xff--blue_violet             :: RGBi-blue_violet             = RGBi 0x8a 0x2b 0xe2--brown                   :: RGBi-brown                   = RGBi 0xa5 0x2a 0x2a--burlywood               :: RGBi-burlywood               = RGBi 0xde 0xb8 0x87--cadet_blue              :: RGBi-cadet_blue              = RGBi 0x5f 0x9e 0xa0--chartreuse              :: RGBi-chartreuse              = RGBi 0x7f 0xff 0x00--chocolate               :: RGBi-chocolate               = RGBi 0xd2 0x69 0x1e--coral                   :: RGBi-coral                   = RGBi 0xff 0x7f 0x50--cornflower_blue         :: RGBi-cornflower_blue         = RGBi 0x64 0x95 0xed--cornsilk                :: RGBi-cornsilk                = RGBi 0xff 0xf8 0xdc--crimson                 :: RGBi-crimson                 = RGBi 0xdc 0x14 0x3c--cyan                    :: RGBi-cyan                    = RGBi 0x00 0xff 0xff--dark_blue               :: RGBi-dark_blue               = RGBi 0x00 0x00 0x8b--dark_cyan               :: RGBi-dark_cyan               = RGBi 0x00 0x8b 0x8b--dark_goldenrod          :: RGBi-dark_goldenrod          = RGBi 0xb8 0x86 0x0b--dark_gray               :: RGBi-dark_gray               = RGBi 0xa9 0xa9 0xa9--dark_green              :: RGBi-dark_green              = RGBi 0x00 0x64 0x00--dark_grey               :: RGBi-dark_grey               = RGBi 0xa9 0xa9 0xa9--dark_khaki              :: RGBi-dark_khaki              = RGBi 0xbd 0xb7 0x6b--dark_magenta            :: RGBi-dark_magenta            = RGBi 0x8b 0x00 0x8b--dark_olive_green        :: RGBi-dark_olive_green        = RGBi 0x55 0x6b 0x2f--dark_orange             :: RGBi-dark_orange             = RGBi 0xff 0x8c 0x00--dark_orchid             :: RGBi-dark_orchid             = RGBi 0x99 0x32 0xcc--dark_red                :: RGBi-dark_red                = RGBi 0x8b 0x00 0x00--dark_salmon             :: RGBi-dark_salmon             = RGBi 0xe9 0x96 0x7a--dark_sea_green          :: RGBi-dark_sea_green          = RGBi 0x8f 0xbc 0x8f--dark_slate_blue         :: RGBi-dark_slate_blue         = RGBi 0x48 0x3d 0x8b--dark_slate_gray         :: RGBi-dark_slate_gray         = RGBi 0x2f 0x4f 0x4f--dark_slate_grey         :: RGBi-dark_slate_grey         = RGBi 0x2f 0x4f 0x4f--dark_turquoise          :: RGBi-dark_turquoise          = RGBi 0x00 0xce 0xd1--dark_violet             :: RGBi-dark_violet             = RGBi 0x94 0x00 0xd3--deep_pink               :: RGBi-deep_pink               = RGBi 0xff 0x14 0x93--deep_sky_blue           :: RGBi-deep_sky_blue           = RGBi 0x00 0xbf 0xff--dim_gray                :: RGBi-dim_gray                = RGBi 0x69 0x69 0x69--dim_grey                :: RGBi-dim_grey                = RGBi 0x69 0x69 0x69--dodger_blue             :: RGBi-dodger_blue             = RGBi 0x1e 0x90 0xff--firebrick               :: RGBi-firebrick               = RGBi 0xb2 0x22 0x22--floral_white            :: RGBi-floral_white            = RGBi 0xff 0xfa 0xf0--forest_green            :: RGBi-forest_green            = RGBi 0x22 0x8b 0x22--fuchsia                 :: RGBi-fuchsia                 = RGBi 0xff 0x00 0xff--gainsboro               :: RGBi-gainsboro               = RGBi 0xdc 0xdc 0xdc--ghost_white             :: RGBi-ghost_white             = RGBi 0xf8 0xf8 0xff--gold                    :: RGBi-gold                    = RGBi 0xff 0xd7 0x00--goldenrod               :: RGBi-goldenrod               = RGBi 0xda 0xa5 0x20--gray                    :: RGBi-gray                    = RGBi 0x80 0x80 0x80--green                   :: RGBi-green                   = RGBi 0x00 0x80 0x00--green_yellow            :: RGBi-green_yellow            = RGBi 0xad 0xff 0x2f--grey                    :: RGBi-grey                    = RGBi 0x80 0x80 0x80--honeydew                :: RGBi-honeydew                = RGBi 0xf0 0xff 0xf0--hot_pink                :: RGBi-hot_pink                = RGBi 0xff 0x69 0xb4--indian_red              :: RGBi-indian_red              = RGBi 0xcd 0x5c 0x5c--indigo                  :: RGBi-indigo                  = RGBi 0x4b 0x00 0x82--ivory                   :: RGBi-ivory                   = RGBi 0xff 0xff 0xf0--khaki                   :: RGBi-khaki                   = RGBi 0xf0 0xe6 0x8c--lavender                :: RGBi-lavender                = RGBi 0xe6 0xe6 0xfa--lavender_blush          :: RGBi-lavender_blush          = RGBi 0xff 0xf0 0xf5--lawn_green              :: RGBi-lawn_green              = RGBi 0x7c 0xfc 0x00--lemon_chiffon           :: RGBi-lemon_chiffon           = RGBi 0xff 0xfa 0xcd--light_blue              :: RGBi-light_blue              = RGBi 0xad 0xd8 0xe6--light_coral             :: RGBi-light_coral             = RGBi 0xf0 0x80 0x80--light_cyan              :: RGBi-light_cyan              = RGBi 0xe0 0xff 0xff--light_goldenrod_yellow  :: RGBi-light_goldenrod_yellow  = RGBi 0xfa 0xfa 0xd2--light_gray              :: RGBi-light_gray              = RGBi 0xd3 0xd3 0xd3--light_green             :: RGBi-light_green             = RGBi 0x90 0xee 0x90--light_grey              :: RGBi-light_grey              = RGBi 0xd3 0xd3 0xd3--light_pink              :: RGBi-light_pink              = RGBi 0xff 0xb6 0xc1--light_salmon            :: RGBi-light_salmon            = RGBi 0xff 0xa0 0x7a--light_sea_green         :: RGBi-light_sea_green         = RGBi 0x20 0xb2 0xaa--light_sky_blue          :: RGBi-light_sky_blue          = RGBi 0x87 0xce 0xfa--light_slate_gray        :: RGBi-light_slate_gray        = RGBi 0x77 0x88 0x99--light_slate_grey        :: RGBi-light_slate_grey        = RGBi 0x77 0x88 0x99--light_steel_blue        :: RGBi-light_steel_blue        = RGBi 0xb0 0xc4 0xde--light_yellow            :: RGBi-light_yellow            = RGBi 0xff 0xff 0xe0--lime                    :: RGBi-lime                    = RGBi 0x00 0xff 0x00--lime_green              :: RGBi-lime_green              = RGBi 0x32 0xcd 0x32--linen                   :: RGBi-linen                   = RGBi 0xfa 0xf0 0xe6--magenta                 :: RGBi-magenta                 = RGBi 0xff 0x00 0xff--maroon                  :: RGBi-maroon                  = RGBi 0x80 0x00 0x00--medium_aquamarine       :: RGBi-medium_aquamarine       = RGBi 0x66 0xcd 0xaa--medium_blue             :: RGBi-medium_blue             = RGBi 0x00 0x00 0xcd--medium_orchid           :: RGBi-medium_orchid           = RGBi 0xba 0x55 0xd3--medium_purple           :: RGBi-medium_purple           = RGBi 0x93 0x70 0xdb--medium_sea_green        :: RGBi-medium_sea_green        = RGBi 0x3c 0xb3 0x71--medium_slate_blue       :: RGBi-medium_slate_blue       = RGBi 0x7b 0x68 0xee--medium_spring_green     :: RGBi-medium_spring_green     = RGBi 0x00 0xfa 0x9a--medium_turquoise        :: RGBi-medium_turquoise        = RGBi 0x48 0xd1 0xcc--medium_violet_red       :: RGBi-medium_violet_red       = RGBi 0xc7 0x15 0x85--midnight_blue           :: RGBi-midnight_blue           = RGBi 0x19 0x19 0x70--mintcream               :: RGBi-mintcream               = RGBi 0xf5 0xff 0xfa--mistyrose               :: RGBi-mistyrose               = RGBi 0xff 0xe4 0xe1--moccasin                :: RGBi-moccasin                = RGBi 0xff 0xe4 0xb5--navajo_white            :: RGBi-navajo_white            = RGBi 0xff 0xde 0xad--navy                    :: RGBi-navy                    = RGBi 0x00 0x00 0x80--old_lace                :: RGBi-old_lace                = RGBi 0xfd 0xf5 0xe6--olive                   :: RGBi-olive                   = RGBi 0x80 0x80 0x00--olive_drab              :: RGBi-olive_drab              = RGBi 0x6b 0x8e 0x23--orange                  :: RGBi-orange                  = RGBi 0xff 0xa5 0x00--orange_red              :: RGBi-orange_red              = RGBi 0xff 0x45 0x00--orchid                  :: RGBi-orchid                  = RGBi 0xda 0x70 0xd6--pale_goldenrod          :: RGBi-pale_goldenrod          = RGBi 0xee 0xe8 0xaa--pale_green              :: RGBi-pale_green              = RGBi 0x98 0xfb 0x98--pale_turquoise          :: RGBi-pale_turquoise          = RGBi 0xaf 0xee 0xee--pale_violet_red         :: RGBi-pale_violet_red         = RGBi 0xdb 0x70 0x93--papaya_whip             :: RGBi-papaya_whip             = RGBi 0xff 0xef 0xd5--peach_puff              :: RGBi-peach_puff              = RGBi 0xff 0xda 0xb9--peru                    :: RGBi-peru                    = RGBi 0xcd 0x85 0x3f--pink                    :: RGBi-pink                    = RGBi 0xff 0xc0 0xcb--plum                    :: RGBi-plum                    = RGBi 0xdd 0xa0 0xdd--powder_blue             :: RGBi-powder_blue             = RGBi 0xb0 0xe0 0xe6--purple                  :: RGBi-purple                  = RGBi 0x80 0x00 0x80--red                     :: RGBi-red                     = RGBi 0xff 0x00 0x00--rosy_brown              :: RGBi-rosy_brown              = RGBi 0xbc 0x8f 0x8f--royal_blue              :: RGBi-royal_blue              = RGBi 0x41 0x69 0xe1--saddle_brown            :: RGBi-saddle_brown            = RGBi 0x8b 0x45 0x13--salmon                  :: RGBi-salmon                  = RGBi 0xfa 0x80 0x72--sandy_brown             :: RGBi-sandy_brown             = RGBi 0xf4 0xa4 0x60--sea_green               :: RGBi-sea_green               = RGBi 0x2e 0x8b 0x57--seashell                :: RGBi-seashell                = RGBi 0xff 0xf5 0xee--sienna                  :: RGBi-sienna                  = RGBi 0xa0 0x52 0x2d--silver                  :: RGBi-silver                  = RGBi 0xc0 0xc0 0xc0--sky_blue                :: RGBi-sky_blue                = RGBi 0x87 0xce 0xeb--slate_blue              :: RGBi-slate_blue              = RGBi 0x6a 0x5a 0xcd--slate_gray              :: RGBi-slate_gray              = RGBi 0x70 0x80 0x90--slate_grey              :: RGBi-slate_grey              = RGBi 0x70 0x80 0x90--snow                    :: RGBi-snow                    = RGBi 0xff 0xfa 0xfa--spring_green            :: RGBi-spring_green            = RGBi 0x00 0xff 0x7f--steel_blue              :: RGBi-steel_blue              = RGBi 0x46 0x82 0xb4--tan                     :: RGBi-tan                     = RGBi 0xd2 0xb4 0x8c--teal                    :: RGBi-teal                    = RGBi 0x00 0x80 0x80--thistle                 :: RGBi-thistle                 = RGBi 0xd8 0xbf 0xd8--tomato                  :: RGBi-tomato                  = RGBi 0xff 0x63 0x47--turquoise               :: RGBi-turquoise               = RGBi 0x40 0xe0 0xd0--violet                  :: RGBi-violet                  = RGBi 0xee 0x82 0xee--wheat                   :: RGBi-wheat                   = RGBi 0xf5 0xde 0xb3--white                   :: RGBi-white                   = RGBi 0xff 0xff 0xff--whitesmoke              :: RGBi-whitesmoke              = RGBi 0xf5 0xf5 0xf5--yellow                  :: RGBi-yellow                  = RGBi 0xff 0xff 0x00--yellow_green            :: RGBi-yellow_green            = RGBi 0x9a 0xcd 0x32-----

@@ -1,1282 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module      :  Wumpus.Basic.Colour.X11Colours--- Copyright   :  (c) Stephen Tetley 2009-2010--- License     :  BSD3------ Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  unstable--- Portability :  GHC------ The X11 \'named colours\', as rgb [0,1] values --------------------------------------------------------------------------------------module Wumpus.Basic.Colour.X11Colours-  ( -  -  -- * Named X11 colours-    antique_white1-  , antique_white2-  , antique_white3-  , antique_white4-  , aquamarine1-  , aquamarine2-  , aquamarine3-  , aquamarine4-  , azure1-  , azure2-  , azure3-  , azure4-  , bisque1-  , bisque2-  , bisque3-  , bisque4-  , blue1-  , blue2-  , blue3-  , blue4-  , brown1-  , brown2-  , brown3-  , brown4-  , burlywood1-  , burlywood2-  , burlywood3-  , burlywood4-  , cadet_blue1-  , cadet_blue2-  , cadet_blue3-  , cadet_blue4-  , chartreuse1-  , chartreuse2-  , chartreuse3-  , chartreuse4-  , chocolate1-  , chocolate2-  , chocolate3-  , chocolate4-  , coral1-  , coral2-  , coral3-  , coral4-  , cornsilk1-  , cornsilk2-  , cornsilk3-  , cornsilk4-  , cyan1-  , cyan2-  , cyan3-  , cyan4-  , dark_goldenrod1-  , dark_goldenrod2-  , dark_goldenrod3-  , dark_goldenrod4-  , dark_olive_green1-  , dark_olive_green2-  , dark_olive_green3-  , dark_olive_green4-  , dark_orange1-  , dark_orange2-  , dark_orange3-  , dark_orange4-  , dark_orchid1-  , dark_orchid2-  , dark_orchid3-  , dark_orchid4-  , dark_sea_green1-  , dark_sea_green2-  , dark_sea_green3-  , dark_sea_green4-  , dark_slate_gray1-  , dark_slate_gray2-  , dark_slate_gray3-  , dark_slate_gray4-  , deep_pink1-  , deep_pink2-  , deep_pink3-  , deep_pink4-  , deep_sky_blue1-  , deep_sky_blue2-  , deep_sky_blue3-  , deep_sky_blue4-  , dodger_blue1-  , dodger_blue2-  , dodger_blue3-  , dodger_blue4-  , firebrick1-  , firebrick2-  , firebrick3-  , firebrick4-  , gold1-  , gold2-  , gold3-  , gold4-  , goldenrod1-  , goldenrod2-  , goldenrod3-  , goldenrod4-  , green1-  , green2-  , green3-  , green4-  , honeydew1-  , honeydew2-  , honeydew3-  , honeydew4-  , hot_pink1-  , hot_pink2-  , hot_pink3-  , hot_pink4-  , indian_red1-  , indian_red2-  , indian_red3-  , indian_red4-  , ivory1-  , ivory2-  , ivory3-  , ivory4-  , khaki1-  , khaki2-  , khaki3-  , khaki4-  , lavender_blush1-  , lavender_blush2-  , lavender_blush3-  , lavender_blush4-  , lemon_chiffon1-  , lemon_chiffon2-  , lemon_chiffon3-  , lemon_chiffon4-  , light_blue1-  , light_blue2-  , light_blue3-  , light_blue4-  , light_cyan1-  , light_cyan2-  , light_cyan3-  , light_cyan4-  , light_goldenrod1-  , light_goldenrod2-  , light_goldenrod3-  , light_goldenrod4-  , light_pink1-  , light_pink2-  , light_pink3-  , light_pink4-  , light_salmon1-  , light_salmon2-  , light_salmon3-  , light_salmon4-  , light_sky_blue1-  , light_sky_blue2-  , light_sky_blue3-  , light_sky_blue4-  , light_steel_blue1-  , light_steel_blue2-  , light_steel_blue3-  , light_steel_blue4-  , light_yellow1-  , light_yellow2-  , light_yellow3-  , light_yellow4-  , magenta1-  , magenta2-  , magenta3-  , magenta4-  , maroon1-  , maroon2-  , maroon3-  , maroon4-  , medium_orchid1-  , medium_orchid2-  , medium_orchid3-  , medium_orchid4-  , medium_purple1-  , medium_purple2-  , medium_purple3-  , medium_purple4-  , misty_rose1-  , misty_rose2-  , misty_rose3-  , misty_rose4-  , navajo_white1-  , navajo_white2-  , navajo_white3-  , navajo_white4-  , olive_drab1-  , olive_drab2-  , olive_drab3-  , olive_drab4-  , orange1-  , orange2-  , orange3-  , orange4-  , orange_red1-  , orange_red2-  , orange_red3-  , orange_red4-  , orchid1-  , orchid2-  , orchid3-  , orchid4-  , pale_green1-  , pale_green2-  , pale_green3-  , pale_green4-  , pale_turquoise1-  , pale_turquoise2-  , pale_turquoise3-  , pale_turquoise4-  , pale_violet_red1-  , pale_violet_red2-  , pale_violet_red3-  , pale_violet_red4-  , peach_puff1-  , peach_puff2-  , peach_puff3-  , peach_puff4-  , pink1-  , pink2-  , pink3-  , pink4-  , plum1-  , plum2-  , plum3-  , plum4-  , purple1-  , purple2-  , purple3-  , purple4-  , red1-  , red2-  , red3-  , red4-  , rosy_brown1-  , rosy_brown2-  , rosy_brown3-  , rosy_brown4-  , royal_blue1-  , royal_blue2-  , royal_blue3-  , royal_blue4-  , salmon1-  , salmon2-  , salmon3-  , salmon4-  , sea_green1-  , sea_green2-  , sea_green3-  , sea_green4-  , seashell1-  , seashell2-  , seashell3-  , seashell4-  , sienna1-  , sienna2-  , sienna3-  , sienna4-  , sky_blue1-  , sky_blue2-  , sky_blue3-  , sky_blue4-  , slate_blue1-  , slate_blue2-  , slate_blue3-  , slate_blue4-  , slate_gray1-  , slate_gray2-  , slate_gray3-  , slate_gray4-  , snow1-  , snow2-  , snow3-  , snow4-  , spring_green1-  , spring_green2-  , spring_green3-  , spring_green4-  , steel_blue1-  , steel_blue2-  , steel_blue3-  , steel_blue4-  , tan1-  , tan2-  , tan3-  , tan4-  , thistle1-  , thistle2-  , thistle3-  , thistle4-  , tomato1-  , tomato2-  , tomato3-  , tomato4-  , turquoise1-  , turquoise2-  , turquoise3-  , turquoise4-  , violet_red1-  , violet_red2-  , violet_red3-  , violet_red4-  , wheat1-  , wheat2-  , wheat3-  , wheat4-  , yellow1-  , yellow2-  , yellow3-  , yellow4--  ) where--import Wumpus.Core.Colour ( RGBi(..) )-------------------------------------------------------------------------------------antique_white1          :: RGBi-antique_white1          = RGBi 0xff 0xef 0xdb--antique_white2          :: RGBi-antique_white2          = RGBi 0xee 0xdf 0xcc--antique_white3          :: RGBi-antique_white3          = RGBi 0xcd 0xc0 0xb0--antique_white4          :: RGBi-antique_white4          = RGBi 0x8b 0x83 0x78--aquamarine1             :: RGBi-aquamarine1             = RGBi 0x7f 0xff 0xd4--aquamarine2             :: RGBi-aquamarine2             = RGBi 0x76 0xee 0xc6--aquamarine3             :: RGBi-aquamarine3             = RGBi 0x66 0xcd 0xaa--aquamarine4             :: RGBi-aquamarine4             = RGBi 0x45 0x8b 0x74--azure1                  :: RGBi-azure1                  = RGBi 0xf0 0xff 0xff--azure2                  :: RGBi-azure2                  = RGBi 0xe0 0xee 0xee--azure3                  :: RGBi-azure3                  = RGBi 0xc1 0xcd 0xcd--azure4                  :: RGBi-azure4                  = RGBi 0x83 0x8b 0x8b--bisque1                 :: RGBi-bisque1                 = RGBi 0xff 0xe4 0xc4--bisque2                 :: RGBi-bisque2                 = RGBi 0xee 0xd5 0xb7--bisque3                 :: RGBi-bisque3                 = RGBi 0xcd 0xb7 0x9e--bisque4                 :: RGBi-bisque4                 = RGBi 0x8b 0x7d 0x6b--blue1                   :: RGBi-blue1                   = RGBi 0x00 0x00 0xff--blue2                   :: RGBi-blue2                   = RGBi 0x00 0x00 0xee--blue3                   :: RGBi-blue3                   = RGBi 0x00 0x00 0xcd--blue4                   :: RGBi-blue4                   = RGBi 0x00 0x00 0x8b--brown1                  :: RGBi-brown1                  = RGBi 0xff 0x40 0x40--brown2                  :: RGBi-brown2                  = RGBi 0xee 0x3b 0x3b--brown3                  :: RGBi-brown3                  = RGBi 0xcd 0x33 0x33--brown4                  :: RGBi-brown4                  = RGBi 0x8b 0x23 0x23--burlywood1              :: RGBi-burlywood1              = RGBi 0xff 0xd3 0x9b--burlywood2              :: RGBi-burlywood2              = RGBi 0xee 0xc5 0x91--burlywood3              :: RGBi-burlywood3              = RGBi 0xcd 0xaa 0x7d--burlywood4              :: RGBi-burlywood4              = RGBi 0x8b 0x73 0x55--cadet_blue1             :: RGBi-cadet_blue1             = RGBi 0x98 0xf5 0xff--cadet_blue2             :: RGBi-cadet_blue2             = RGBi 0x8e 0xe5 0xee--cadet_blue3             :: RGBi-cadet_blue3             = RGBi 0x7a 0xc5 0xcd--cadet_blue4             :: RGBi-cadet_blue4             = RGBi 0x53 0x86 0x8b--chartreuse1             :: RGBi-chartreuse1             = RGBi 0x7f 0xff 0x00--chartreuse2             :: RGBi-chartreuse2             = RGBi 0x76 0xee 0x00--chartreuse3             :: RGBi-chartreuse3             = RGBi 0x66 0xcd 0x00--chartreuse4             :: RGBi-chartreuse4             = RGBi 0x45 0x8b 0x00--chocolate1              :: RGBi-chocolate1              = RGBi 0xff 0x7f 0x24--chocolate2              :: RGBi-chocolate2              = RGBi 0xee 0x76 0x21--chocolate3              :: RGBi-chocolate3              = RGBi 0xcd 0x66 0x1d--chocolate4              :: RGBi-chocolate4              = RGBi 0x8b 0x45 0x13--coral1                  :: RGBi-coral1                  = RGBi 0xff 0x72 0x56--coral2                  :: RGBi-coral2                  = RGBi 0xee 0x6a 0x50--coral3                  :: RGBi-coral3                  = RGBi 0xcd 0x5b 0x45--coral4                  :: RGBi-coral4                  = RGBi 0x8b 0x3e 0x2f--cornsilk1               :: RGBi-cornsilk1               = RGBi 0xff 0xf8 0xdc--cornsilk2               :: RGBi-cornsilk2               = RGBi 0xee 0xe8 0xcd--cornsilk3               :: RGBi-cornsilk3               = RGBi 0xcd 0xc8 0xb1--cornsilk4               :: RGBi-cornsilk4               = RGBi 0x8b 0x88 0x78--cyan1                   :: RGBi-cyan1                   = RGBi 0x00 0xff 0xff--cyan2                   :: RGBi-cyan2                   = RGBi 0x00 0xee 0xee--cyan3                   :: RGBi-cyan3                   = RGBi 0x00 0xcd 0xcd--cyan4                   :: RGBi-cyan4                   = RGBi 0x00 0x8b 0x8b--dark_goldenrod1         :: RGBi-dark_goldenrod1         = RGBi 0xff 0xb9 0x0f--dark_goldenrod2         :: RGBi-dark_goldenrod2         = RGBi 0xee 0xad 0x0e--dark_goldenrod3         :: RGBi-dark_goldenrod3         = RGBi 0xcd 0x95 0x0c--dark_goldenrod4         :: RGBi-dark_goldenrod4         = RGBi 0x8b 0x65 0x08--dark_olive_green1       :: RGBi-dark_olive_green1       = RGBi 0xca 0xff 0x70--dark_olive_green2       :: RGBi-dark_olive_green2       = RGBi 0xbc 0xee 0x68--dark_olive_green3       :: RGBi-dark_olive_green3       = RGBi 0xa2 0xcd 0x5a--dark_olive_green4       :: RGBi-dark_olive_green4       = RGBi 0x6e 0x8b 0x3d--dark_orange1            :: RGBi-dark_orange1            = RGBi 0xff 0x7f 0x00--dark_orange2            :: RGBi-dark_orange2            = RGBi 0xee 0x76 0x00--dark_orange3            :: RGBi-dark_orange3            = RGBi 0xcd 0x66 0x00--dark_orange4            :: RGBi-dark_orange4            = RGBi 0x8b 0x45 0x00--dark_orchid1            :: RGBi-dark_orchid1            = RGBi 0xbf 0x3e 0xff--dark_orchid2            :: RGBi-dark_orchid2            = RGBi 0xb2 0x3a 0xee--dark_orchid3            :: RGBi-dark_orchid3            = RGBi 0x9a 0x32 0xcd--dark_orchid4            :: RGBi-dark_orchid4            = RGBi 0x68 0x22 0x8b--dark_sea_green1         :: RGBi-dark_sea_green1         = RGBi 0xc1 0xff 0xc1--dark_sea_green2         :: RGBi-dark_sea_green2         = RGBi 0xb4 0xee 0xb4--dark_sea_green3         :: RGBi-dark_sea_green3         = RGBi 0x9b 0xcd 0x9b--dark_sea_green4         :: RGBi-dark_sea_green4         = RGBi 0x69 0x8b 0x69--dark_slate_gray1        :: RGBi-dark_slate_gray1        = RGBi 0x97 0xff 0xff--dark_slate_gray2        :: RGBi-dark_slate_gray2        = RGBi 0x8d 0xee 0xee--dark_slate_gray3        :: RGBi-dark_slate_gray3        = RGBi 0x79 0xcd 0xcd--dark_slate_gray4        :: RGBi-dark_slate_gray4        = RGBi 0x52 0x8b 0x8b--deep_pink1              :: RGBi-deep_pink1              = RGBi 0xff 0x14 0x93--deep_pink2              :: RGBi-deep_pink2              = RGBi 0xee 0x12 0x89--deep_pink3              :: RGBi-deep_pink3              = RGBi 0xcd 0x10 0x76--deep_pink4              :: RGBi-deep_pink4              = RGBi 0x8b 0x0a 0x50--deep_sky_blue1          :: RGBi-deep_sky_blue1          = RGBi 0x00 0xbf 0xff--deep_sky_blue2          :: RGBi-deep_sky_blue2          = RGBi 0x00 0xb2 0xee--deep_sky_blue3          :: RGBi-deep_sky_blue3          = RGBi 0x00 0x9a 0xcd--deep_sky_blue4          :: RGBi-deep_sky_blue4          = RGBi 0x00 0x68 0x8b--dodger_blue1            :: RGBi-dodger_blue1            = RGBi 0x1e 0x90 0xff--dodger_blue2            :: RGBi-dodger_blue2            = RGBi 0x1c 0x86 0xee--dodger_blue3            :: RGBi-dodger_blue3            = RGBi 0x18 0x74 0xcd--dodger_blue4            :: RGBi-dodger_blue4            = RGBi 0x10 0x4e 0x8b--firebrick1              :: RGBi-firebrick1              = RGBi 0xff 0x30 0x30--firebrick2              :: RGBi-firebrick2              = RGBi 0xee 0x2c 0x2c--firebrick3              :: RGBi-firebrick3              = RGBi 0xcd 0x26 0x26--firebrick4              :: RGBi-firebrick4              = RGBi 0x8b 0x1a 0x1a--gold1                   :: RGBi-gold1                   = RGBi 0xff 0xd7 0x00--gold2                   :: RGBi-gold2                   = RGBi 0xee 0xc9 0x00--gold3                   :: RGBi-gold3                   = RGBi 0xcd 0xad 0x00--gold4                   :: RGBi-gold4                   = RGBi 0x8b 0x75 0x00--goldenrod1              :: RGBi-goldenrod1              = RGBi 0xff 0xc1 0x25--goldenrod2              :: RGBi-goldenrod2              = RGBi 0xee 0xb4 0x22--goldenrod3              :: RGBi-goldenrod3              = RGBi 0xcd 0x9b 0x1d--goldenrod4              :: RGBi-goldenrod4              = RGBi 0x8b 0x69 0x14--green1                  :: RGBi-green1                  = RGBi 0x00 0xff 0x00--green2                  :: RGBi-green2                  = RGBi 0x00 0xee 0x00--green3                  :: RGBi-green3                  = RGBi 0x00 0xcd 0x00--green4                  :: RGBi-green4                  = RGBi 0x00 0x8b 0x00--honeydew1               :: RGBi-honeydew1               = RGBi 0xf0 0xff 0xf0--honeydew2               :: RGBi-honeydew2               = RGBi 0xe0 0xee 0xe0--honeydew3               :: RGBi-honeydew3               = RGBi 0xc1 0xcd 0xc1--honeydew4               :: RGBi-honeydew4               = RGBi 0x83 0x8b 0x83--hot_pink1               :: RGBi-hot_pink1               = RGBi 0xff 0x6e 0xb4--hot_pink2               :: RGBi-hot_pink2               = RGBi 0xee 0x6a 0xa7--hot_pink3               :: RGBi-hot_pink3               = RGBi 0xcd 0x60 0x90--hot_pink4               :: RGBi-hot_pink4               = RGBi 0x8b 0x3a 0x62--indian_red1             :: RGBi-indian_red1             = RGBi 0xff 0x6a 0x6a--indian_red2             :: RGBi-indian_red2             = RGBi 0xee 0x63 0x63--indian_red3             :: RGBi-indian_red3             = RGBi 0xcd 0x55 0x55--indian_red4             :: RGBi-indian_red4             = RGBi 0x8b 0x3a 0x3a--ivory1                  :: RGBi-ivory1                  = RGBi 0xff 0xff 0xf0--ivory2                  :: RGBi-ivory2                  = RGBi 0xee 0xee 0xe0--ivory3                  :: RGBi-ivory3                  = RGBi 0xcd 0xcd 0xc1--ivory4                  :: RGBi-ivory4                  = RGBi 0x8b 0x8b 0x83--khaki1                  :: RGBi-khaki1                  = RGBi 0xff 0xf6 0x8f--khaki2                  :: RGBi-khaki2                  = RGBi 0xee 0xe6 0x85--khaki3                  :: RGBi-khaki3                  = RGBi 0xcd 0xc6 0x73--khaki4                  :: RGBi-khaki4                  = RGBi 0x8b 0x86 0x4e--lavender_blush1         :: RGBi-lavender_blush1         = RGBi 0xff 0xf0 0xf5--lavender_blush2         :: RGBi-lavender_blush2         = RGBi 0xee 0xe0 0xe5--lavender_blush3         :: RGBi-lavender_blush3         = RGBi 0xcd 0xc1 0xc5--lavender_blush4         :: RGBi-lavender_blush4         = RGBi 0x8b 0x83 0x86--lemon_chiffon1          :: RGBi-lemon_chiffon1          = RGBi 0xff 0xfa 0xcd--lemon_chiffon2          :: RGBi-lemon_chiffon2          = RGBi 0xee 0xe9 0xbf--lemon_chiffon3          :: RGBi-lemon_chiffon3          = RGBi 0xcd 0xc9 0xa5--lemon_chiffon4          :: RGBi-lemon_chiffon4          = RGBi 0x8b 0x89 0x70--light_blue1             :: RGBi-light_blue1             = RGBi 0xbf 0xef 0xff--light_blue2             :: RGBi-light_blue2             = RGBi 0xb2 0xdf 0xee--light_blue3             :: RGBi-light_blue3             = RGBi 0x9a 0xc0 0xcd--light_blue4             :: RGBi-light_blue4             = RGBi 0x68 0x83 0x8b--light_cyan1             :: RGBi-light_cyan1             = RGBi 0xe0 0xff 0xff--light_cyan2             :: RGBi-light_cyan2             = RGBi 0xd1 0xee 0xee--light_cyan3             :: RGBi-light_cyan3             = RGBi 0xb4 0xcd 0xcd--light_cyan4             :: RGBi-light_cyan4             = RGBi 0x7a 0x8b 0x8b--light_goldenrod1        :: RGBi-light_goldenrod1        = RGBi 0xff 0xec 0x8b--light_goldenrod2        :: RGBi-light_goldenrod2        = RGBi 0xee 0xdc 0x82--light_goldenrod3        :: RGBi-light_goldenrod3        = RGBi 0xcd 0xbe 0x70--light_goldenrod4        :: RGBi-light_goldenrod4        = RGBi 0x8b 0x81 0x4c--light_pink1             :: RGBi-light_pink1             = RGBi 0xff 0xae 0xb9--light_pink2             :: RGBi-light_pink2             = RGBi 0xee 0xa2 0xad--light_pink3             :: RGBi-light_pink3             = RGBi 0xcd 0x8c 0x95--light_pink4             :: RGBi-light_pink4             = RGBi 0x8b 0x5f 0x65--light_salmon1           :: RGBi-light_salmon1           = RGBi 0xff 0xa0 0x7a--light_salmon2           :: RGBi-light_salmon2           = RGBi 0xee 0x95 0x72--light_salmon3           :: RGBi-light_salmon3           = RGBi 0xcd 0x81 0x62--light_salmon4           :: RGBi-light_salmon4           = RGBi 0x8b 0x57 0x42--light_sky_blue1         :: RGBi-light_sky_blue1         = RGBi 0xb0 0xe2 0xff--light_sky_blue2         :: RGBi-light_sky_blue2         = RGBi 0xa4 0xd3 0xee--light_sky_blue3         :: RGBi-light_sky_blue3         = RGBi 0x8d 0xb6 0xcd--light_sky_blue4         :: RGBi-light_sky_blue4         = RGBi 0x60 0x7b 0x8b--light_steel_blue1       :: RGBi-light_steel_blue1       = RGBi 0xca 0xe1 0xff--light_steel_blue2       :: RGBi-light_steel_blue2       = RGBi 0xbc 0xd2 0xee--light_steel_blue3       :: RGBi-light_steel_blue3       = RGBi 0xa2 0xb5 0xcd--light_steel_blue4       :: RGBi-light_steel_blue4       = RGBi 0x6e 0x7b 0x8b--light_yellow1           :: RGBi-light_yellow1           = RGBi 0xff 0xff 0xe0--light_yellow2           :: RGBi-light_yellow2           = RGBi 0xee 0xee 0xd1--light_yellow3           :: RGBi-light_yellow3           = RGBi 0xcd 0xcd 0xb4--light_yellow4           :: RGBi-light_yellow4           = RGBi 0x8b 0x8b 0x7a--magenta1                :: RGBi-magenta1                = RGBi 0xff 0x00 0xff--magenta2                :: RGBi-magenta2                = RGBi 0xee 0x00 0xee--magenta3                :: RGBi-magenta3                = RGBi 0xcd 0x00 0xcd--magenta4                :: RGBi-magenta4                = RGBi 0x8b 0x00 0x8b--maroon1                 :: RGBi-maroon1                 = RGBi 0xff 0x34 0xb3--maroon2                 :: RGBi-maroon2                 = RGBi 0xee 0x30 0xa7--maroon3                 :: RGBi-maroon3                 = RGBi 0xcd 0x29 0x90--maroon4                 :: RGBi-maroon4                 = RGBi 0x8b 0x1c 0x62--medium_orchid1          :: RGBi-medium_orchid1          = RGBi 0xe0 0x66 0xff--medium_orchid2          :: RGBi-medium_orchid2          = RGBi 0xd1 0x5f 0xee--medium_orchid3          :: RGBi-medium_orchid3          = RGBi 0xb4 0x52 0xcd--medium_orchid4          :: RGBi-medium_orchid4          = RGBi 0x7a 0x37 0x8b--medium_purple1          :: RGBi-medium_purple1          = RGBi 0xab 0x82 0xff--medium_purple2          :: RGBi-medium_purple2          = RGBi 0x9f 0x79 0xee--medium_purple3          :: RGBi-medium_purple3          = RGBi 0x89 0x68 0xcd--medium_purple4          :: RGBi-medium_purple4          = RGBi 0x5d 0x47 0x8b--misty_rose1             :: RGBi-misty_rose1             = RGBi 0xff 0xe4 0xe1--misty_rose2             :: RGBi-misty_rose2             = RGBi 0xee 0xd5 0xd2--misty_rose3             :: RGBi-misty_rose3             = RGBi 0xcd 0xb7 0xb5--misty_rose4             :: RGBi-misty_rose4             = RGBi 0x8b 0x7d 0x7b--navajo_white1           :: RGBi-navajo_white1           = RGBi 0xff 0xde 0xad--navajo_white2           :: RGBi-navajo_white2           = RGBi 0xee 0xcf 0xa1--navajo_white3           :: RGBi-navajo_white3           = RGBi 0xcd 0xb3 0x8b--navajo_white4           :: RGBi-navajo_white4           = RGBi 0x8b 0x79 0x5e--olive_drab1             :: RGBi-olive_drab1             = RGBi 0xc0 0xff 0x3e--olive_drab2             :: RGBi-olive_drab2             = RGBi 0xb3 0xee 0x3a--olive_drab3             :: RGBi-olive_drab3             = RGBi 0x9a 0xcd 0x32--olive_drab4             :: RGBi-olive_drab4             = RGBi 0x69 0x8b 0x22--orange1                 :: RGBi-orange1                 = RGBi 0xff 0xa5 0x00--orange2                 :: RGBi-orange2                 = RGBi 0xee 0x9a 0x00--orange3                 :: RGBi-orange3                 = RGBi 0xcd 0x85 0x00--orange4                 :: RGBi-orange4                 = RGBi 0x8b 0x5a 0x00--orange_red1             :: RGBi-orange_red1             = RGBi 0xff 0x45 0x00--orange_red2             :: RGBi-orange_red2             = RGBi 0xee 0x40 0x00--orange_red3             :: RGBi-orange_red3             = RGBi 0xcd 0x37 0x00--orange_red4             :: RGBi-orange_red4             = RGBi 0x8b 0x25 0x00--orchid1                 :: RGBi-orchid1                 = RGBi 0xff 0x83 0xfa--orchid2                 :: RGBi-orchid2                 = RGBi 0xee 0x7a 0xe9--orchid3                 :: RGBi-orchid3                 = RGBi 0xcd 0x69 0xc9--orchid4                 :: RGBi-orchid4                 = RGBi 0x8b 0x47 0x89--pale_green1             :: RGBi-pale_green1             = RGBi 0x9a 0xff 0x9a--pale_green2             :: RGBi-pale_green2             = RGBi 0x90 0xee 0x90--pale_green3             :: RGBi-pale_green3             = RGBi 0x7c 0xcd 0x7c--pale_green4             :: RGBi-pale_green4             = RGBi 0x54 0x8b 0x54--pale_turquoise1         :: RGBi-pale_turquoise1         = RGBi 0xbb 0xff 0xff--pale_turquoise2         :: RGBi-pale_turquoise2         = RGBi 0xae 0xee 0xee--pale_turquoise3         :: RGBi-pale_turquoise3         = RGBi 0x96 0xcd 0xcd--pale_turquoise4         :: RGBi-pale_turquoise4         = RGBi 0x66 0x8b 0x8b--pale_violet_red1        :: RGBi-pale_violet_red1        = RGBi 0xff 0x82 0xab--pale_violet_red2        :: RGBi-pale_violet_red2        = RGBi 0xee 0x79 0x9f--pale_violet_red3        :: RGBi-pale_violet_red3        = RGBi 0xcd 0x68 0x89--pale_violet_red4        :: RGBi-pale_violet_red4        = RGBi 0x8b 0x47 0x5d--peach_puff1             :: RGBi-peach_puff1             = RGBi 0xff 0xda 0xb9--peach_puff2             :: RGBi-peach_puff2             = RGBi 0xee 0xcb 0xad--peach_puff3             :: RGBi-peach_puff3             = RGBi 0xcd 0xaf 0x95--peach_puff4             :: RGBi-peach_puff4             = RGBi 0x8b 0x77 0x65--pink1                   :: RGBi-pink1                   = RGBi 0xff 0xb5 0xc5--pink2                   :: RGBi-pink2                   = RGBi 0xee 0xa9 0xb8--pink3                   :: RGBi-pink3                   = RGBi 0xcd 0x91 0x9e--pink4                   :: RGBi-pink4                   = RGBi 0x8b 0x63 0x6c--plum1                   :: RGBi-plum1                   = RGBi 0xff 0xbb 0xff--plum2                   :: RGBi-plum2                   = RGBi 0xee 0xae 0xee--plum3                   :: RGBi-plum3                   = RGBi 0xcd 0x96 0xcd--plum4                   :: RGBi-plum4                   = RGBi 0x8b 0x66 0x8b--purple1                 :: RGBi-purple1                 = RGBi 0x9b 0x30 0xff--purple2                 :: RGBi-purple2                 = RGBi 0x91 0x2c 0xee--purple3                 :: RGBi-purple3                 = RGBi 0x7d 0x26 0xcd--purple4                 :: RGBi-purple4                 = RGBi 0x55 0x1a 0x8b--red1                    :: RGBi-red1                    = RGBi 0xff 0x00 0x00--red2                    :: RGBi-red2                    = RGBi 0xee 0x00 0x00--red3                    :: RGBi-red3                    = RGBi 0xcd 0x00 0x00--red4                    :: RGBi-red4                    = RGBi 0x8b 0x00 0x00--rosy_brown1             :: RGBi-rosy_brown1             = RGBi 0xff 0xc1 0xc1--rosy_brown2             :: RGBi-rosy_brown2             = RGBi 0xee 0xb4 0xb4--rosy_brown3             :: RGBi-rosy_brown3             = RGBi 0xcd 0x9b 0x9b--rosy_brown4             :: RGBi-rosy_brown4             = RGBi 0x8b 0x69 0x69--royal_blue1             :: RGBi-royal_blue1             = RGBi 0x48 0x76 0xff--royal_blue2             :: RGBi-royal_blue2             = RGBi 0x43 0x6e 0xee--royal_blue3             :: RGBi-royal_blue3             = RGBi 0x3a 0x5f 0xcd--royal_blue4             :: RGBi-royal_blue4             = RGBi 0x27 0x40 0x8b---salmon1                 :: RGBi-salmon1                 = RGBi 0xff 0x8c 0x69--salmon2                 :: RGBi-salmon2                 = RGBi 0xee 0x82 0x62--salmon3                 :: RGBi-salmon3                 = RGBi 0xcd 0x70 0x54--salmon4                 :: RGBi-salmon4                 = RGBi 0x8b 0x4c 0x39--sea_green1              :: RGBi-sea_green1              = RGBi 0x54 0xff 0x9f--sea_green2              :: RGBi-sea_green2              = RGBi 0x4e 0xee 0x94--sea_green3              :: RGBi-sea_green3              = RGBi 0x43 0xcd 0x80--sea_green4              :: RGBi-sea_green4              = RGBi 0x2e 0x8b 0x57--seashell1               :: RGBi-seashell1               = RGBi 0xff 0xf5 0xee--seashell2               :: RGBi-seashell2               = RGBi 0xee 0xe5 0xde--seashell3               :: RGBi-seashell3               = RGBi 0xcd 0xc5 0xbf--seashell4               :: RGBi-seashell4               = RGBi 0x8b 0x86 0x82--sienna1                 :: RGBi-sienna1                 = RGBi 0xff 0x82 0x47--sienna2                 :: RGBi-sienna2                 = RGBi 0xee 0x79 0x42--sienna3                 :: RGBi-sienna3                 = RGBi 0xcd 0x68 0x39--sienna4                 :: RGBi-sienna4                 = RGBi 0x8b 0x47 0x26--sky_blue1               :: RGBi-sky_blue1               = RGBi 0x87 0xce 0xff--sky_blue2               :: RGBi-sky_blue2               = RGBi 0x7e 0xc0 0xee--sky_blue3               :: RGBi-sky_blue3               = RGBi 0x6c 0xa6 0xcd--sky_blue4               :: RGBi-sky_blue4               = RGBi 0x4a 0x70 0x8b--slate_blue1             :: RGBi-slate_blue1             = RGBi 0x83 0x6f 0xff--slate_blue2             :: RGBi-slate_blue2             = RGBi 0x7a 0x67 0xee--slate_blue3             :: RGBi-slate_blue3             = RGBi 0x69 0x59 0xcd--slate_blue4             :: RGBi-slate_blue4             = RGBi 0x47 0x3c 0x8b--slate_gray1             :: RGBi-slate_gray1             = RGBi 0xc6 0xe2 0xff--slate_gray2             :: RGBi-slate_gray2             = RGBi 0xb9 0xd3 0xee--slate_gray3             :: RGBi-slate_gray3             = RGBi 0x9f 0xb6 0xcd--slate_gray4             :: RGBi-slate_gray4             = RGBi 0x6c 0x7b 0x8b--snow1                   :: RGBi-snow1                   = RGBi 0xff 0xfa 0xfa--snow2                   :: RGBi-snow2                   = RGBi 0xee 0xe9 0xe9--snow3                   :: RGBi-snow3                   = RGBi 0xcd 0xc9 0xc9--snow4                   :: RGBi-snow4                   = RGBi 0x8b 0x89 0x89--spring_green1           :: RGBi-spring_green1           = RGBi 0x00 0xff 0x7f--spring_green2           :: RGBi-spring_green2           = RGBi 0x00 0xee 0x76--spring_green3           :: RGBi-spring_green3           = RGBi 0x00 0xcd 0x66--spring_green4           :: RGBi-spring_green4           = RGBi 0x00 0x8b 0x45--steel_blue1             :: RGBi-steel_blue1             = RGBi 0x63 0xb8 0xff--steel_blue2             :: RGBi-steel_blue2             = RGBi 0x5c 0xac 0xee--steel_blue3             :: RGBi-steel_blue3             = RGBi 0x4f 0x94 0xcd--steel_blue4             :: RGBi-steel_blue4             = RGBi 0x36 0x64 0x8b--tan1                    :: RGBi-tan1                    = RGBi 0xff 0xa5 0x4f--tan2                    :: RGBi-tan2                    = RGBi 0xee 0x9a 0x49--tan3                    :: RGBi-tan3                    = RGBi 0xcd 0x85 0x3f--tan4                    :: RGBi-tan4                    = RGBi 0x8b 0x5a 0x2b--thistle1                :: RGBi-thistle1                = RGBi 0xff 0xe1 0xff--thistle2                :: RGBi-thistle2                = RGBi 0xee 0xd2 0xee--thistle3                :: RGBi-thistle3                = RGBi 0xcd 0xb5 0xcd--thistle4                :: RGBi-thistle4                = RGBi 0x8b 0x7b 0x8b--tomato1                 :: RGBi-tomato1                 = RGBi 0xff 0x63 0x47--tomato2                 :: RGBi-tomato2                 = RGBi 0xee 0x5c 0x42--tomato3                 :: RGBi-tomato3                 = RGBi 0xcd 0x4f 0x39--tomato4                 :: RGBi-tomato4                 = RGBi 0x8b 0x36 0x26--turquoise1              :: RGBi-turquoise1              = RGBi 0x00 0xf5 0xff--turquoise2              :: RGBi-turquoise2              = RGBi 0x00 0xe5 0xee--turquoise3              :: RGBi-turquoise3              = RGBi 0x00 0xc5 0xcd--turquoise4              :: RGBi-turquoise4              = RGBi 0x00 0x86 0x8b--violet_red1             :: RGBi-violet_red1             = RGBi 0xff 0x3e 0x96--violet_red2             :: RGBi-violet_red2             = RGBi 0xee 0x3a 0x8c--violet_red3             :: RGBi-violet_red3             = RGBi 0xcd 0x32 0x78--violet_red4             :: RGBi-violet_red4             = RGBi 0x8b 0x22 0x52--wheat1                  :: RGBi-wheat1                  = RGBi 0xff 0xe7 0xba--wheat2                  :: RGBi-wheat2                  = RGBi 0xee 0xd8 0xae--wheat3                  :: RGBi-wheat3                  = RGBi 0xcd 0xba 0x96--wheat4                  :: RGBi-wheat4                  = RGBi 0x8b 0x7e 0x66--yellow1                 :: RGBi-yellow1                 = RGBi 0xff 0xff 0x00--yellow2                 :: RGBi-yellow2                 = RGBi 0xee 0xee 0x00--yellow3                 :: RGBi-yellow3                 = RGBi 0xcd 0xcd 0x00--yellow4                 :: RGBi-yellow4                 = RGBi 0x8b 0x8b 0x00------

@@ -1,244 +0,0 @@-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE ExistentialQuantification  #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module      :  Wumpus.Basic.Dots.AnchorDots--- Copyright   :  (c) Stephen Tetley 2010--- License     :  BSD3------ Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable--- Portability :  GHC------ Dots with anchors.------ In many cases a surrounding circle is used to locate anchor--- points - this could be improved to use the actual dot border --- at some point.--------------------------------------------------------------------------------------module Wumpus.Basic.Dots.AnchorDots-  ( --  -- * Existential anchor type-    DotAnchor- -  , DotLocImage-  , DDotLocImage--  -- * Dots with anchor points-  , dotChar-  , dotText-  , dotHLine-  , dotVLine-  , dotX-  , dotPlus-  , dotCross-  , dotDiamond-  , dotFDiamond--  , dotDisk-  , dotSquare-  , dotCircle-  , dotPentagon-  , dotStar--  , dotAsterisk-  , dotOPlus-  , dotOCross-  , dotFOCross--  ) where--import Wumpus.Basic.Dots.Marks-import Wumpus.Basic.Graphic-import Wumpus.Basic.Text.LRText-import Wumpus.Basic.Utils.Intersection--import Wumpus.Core                              -- package: wumpus-core--import Data.AffineSpace                         -- package: vector-space------ An existential thing that supports anchors.--- This means any dot can retun the same (opaque) structure------ But it does mean that which anchor class are supported is --- fixed - the datatype needs a field for each one.--- Supporting north, southeast etc. will also be tedious...----data DotAnchor u = forall s.  -                    DotAnchor { center_anchor   :: Point2 u-                              , radial_anchor   :: Radian   -> Point2 u-                              , cardinal_anchor :: Cardinal -> Point2 u }--data Cardinal = NN | NE | EE | SE | SS | SW | WW | NW-  deriving (Eq,Show) --type instance DUnit (DotAnchor u) = u--instance CenterAnchor (DotAnchor u) where-  center (DotAnchor ca _ _) = ca--instance RadialAnchor (DotAnchor u) where-   radialAnchor theta (DotAnchor _ ra _) = ra theta--instance CardinalAnchor (DotAnchor u) where-   north (DotAnchor _ _ c1) = c1 NN-   south (DotAnchor _ _ c1) = c1 SS-   east  (DotAnchor _ _ c1) = c1 EE-   west  (DotAnchor _ _ c1) = c1 WW----instance CardinalAnchor2 (DotAnchor u) where-   northeast (DotAnchor _ _ c1) = c1 NE-   southeast (DotAnchor _ _ c1) = c1 SE-   southwest (DotAnchor _ _ c1) = c1 SW-   northwest (DotAnchor _ _ c1) = c1 NW---radialCardinal :: Floating u => u -> Point2 u ->  Cardinal -> Point2 u-radialCardinal rad ctr NN = ctr .+^ (avec (pi/2)     rad) -radialCardinal rad ctr NE = ctr .+^ (avec (pi/4)     rad) -radialCardinal rad ctr EE = ctr .+^ (avec  0         rad) -radialCardinal rad ctr SE = ctr .+^ (avec (7/4 * pi) rad) -radialCardinal rad ctr SS = ctr .+^ (avec (6/4 * pi) rad) -radialCardinal rad ctr SW = ctr .+^ (avec (5/4 * pi) rad) -radialCardinal rad ctr WW = ctr .+^ (avec  pi        rad) -radialCardinal rad ctr NW = ctr .+^ (avec (3/4 * pi) rad) ----- Rectangle cardinal points are at \"middles and corners\".-----rectCardinal :: Floating u => u ->  u -> Point2 u -> Cardinal -> Point2 u-rectCardinal _  hh ctr NN = ctr .+^ (vvec hh) -rectCardinal hw hh ctr NE = ctr .+^ (vec  hw     hh) -rectCardinal hw _  ctr EE = ctr .+^ (hvec hw) -rectCardinal hw hh ctr SE = ctr .+^ (vec  hw    (-hh)) -rectCardinal _  hh ctr SS = ctr .+^ (vvec (-hh)) -rectCardinal hw hh ctr SW = ctr .+^ (vec  (-hw) (-hh) )-rectCardinal hw _  ctr WW = ctr .+^ (hvec (-hw)) -rectCardinal hw hh ctr NW = ctr .+^ (vec  (-hw)  hh) ---rectangleAnchor :: (Real u, Floating u) => u -> u -> Point2 u -> DotAnchor u-rectangleAnchor hw hh ctr = -    DotAnchor { center_anchor   = ctr-              , radial_anchor   = fn  -              , cardinal_anchor = rectCardinal hw hh ctr }-  where-    fn theta =  maybe ctr id $ findIntersect ctr theta -                             $ rectangleLines ctr hw hh--bboxRectAnchor  :: (Real u, Floating u) => BoundingBox u -> DotAnchor u-bboxRectAnchor (BBox bl@(P2 x1 y1) (P2 x2 y2)) =-   let hw = 0.5 * (x2 - x1)-       hh = 0.5 * (y2 - y1)-   in rectangleAnchor hw hh (bl .+^ vec hw hh)--rectangleLDO :: (Real u, Floating u) -             => u -> u -> LocDrawingInfo u (DotAnchor u)-rectangleLDO w h = promote1 $ \pt -> wrap $ rectangleAnchor (w*0.5) (h*0.5) pt---circleAnchor :: Floating u => u -> Point2 u -> DotAnchor u-circleAnchor rad ctr = DotAnchor ctr -                                 (\theta -> ctr .+^ (avec theta rad))-                                 (radialCardinal rad ctr)--circleLDO :: (Floating u, FromPtSize u) => LocDrawingInfo u (DotAnchor u)-circleLDO = bind1 (static1 markHeight) $ \diam -> -    promote1 $ \pt -> wrap $ circleAnchor (diam * 0.5) pt--------------------------------------------------------------------------------------type DotLocImage u = LocImage u (DotAnchor u) --type DDotLocImage = DotLocImage Double --dotChar :: (Floating u, Real u, FromPtSize u) -        => Char -> DotLocImage u-dotChar ch = dotText [ch]----- | Note - dots now use font metrics...----dotText :: (Floating u, Real u, FromPtSize u) -        => String -> DotLocImage u -dotText ss = locImageMapL bboxRectAnchor (singleLineCC ss)----- Is this generally useful? ...----locImageMapL :: (a -> b) -> LocImage u a -> LocImage u b-locImageMapL f = postpro1 $ \(a,prim) -> (f a, prim)----dotHLine :: (Floating u, FromPtSize u) => DotLocImage u-dotHLine = intoLocImage circleLDO markHLine---dotVLine :: (Floating u, FromPtSize u) => DotLocImage u-dotVLine = intoLocImage circleLDO markVLine---dotX :: (Floating u, FromPtSize u) => DotLocImage u-dotX = intoLocImage circleLDO markX--dotPlus :: (Floating u, FromPtSize u) => DotLocImage u-dotPlus = intoLocImage circleLDO markPlus--dotCross :: (Floating u, FromPtSize u) => DotLocImage u-dotCross = intoLocImage circleLDO markCross--dotDiamond :: (Floating u, FromPtSize u) => DotLocImage u-dotDiamond = intoLocImage circleLDO markDiamond--dotFDiamond :: (Floating u, FromPtSize u) => DotLocImage u-dotFDiamond = intoLocImage circleLDO markFDiamond----dotDisk :: (Floating u, FromPtSize u) => DotLocImage u-dotDisk = intoLocImage circleLDO markDisk---dotSquare :: (Floating u, Real u, FromPtSize u) => DotLocImage u-dotSquare = bind1 (static1 markHeight) $ \ h ->-    intoLocImage (rectangleLDO h h) markSquare-----dotCircle :: (Floating u, FromPtSize u) => DotLocImage u-dotCircle = intoLocImage circleLDO markCircle---dotPentagon :: (Floating u, FromPtSize u) => DotLocImage u-dotPentagon = intoLocImage circleLDO markPentagon--dotStar :: (Floating u, FromPtSize u) => DotLocImage u-dotStar = intoLocImage circleLDO markStar---dotAsterisk :: (Floating u, FromPtSize u) => DotLocImage u-dotAsterisk = intoLocImage circleLDO markAsterisk--dotOPlus :: (Floating u, FromPtSize u) => DotLocImage u-dotOPlus = intoLocImage circleLDO markOPlus--dotOCross :: (Floating u, FromPtSize u) => DotLocImage u-dotOCross = intoLocImage circleLDO markOCross--dotFOCross :: (Floating u, FromPtSize u) => DotLocImage u-dotFOCross = intoLocImage circleLDO markFOCross

@@ -1,229 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module      :  Wumpus.Basic.Dots.Marks--- Copyright   :  (c) Stephen Tetley 2010--- License     :  BSD3------ Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable--- Portability :  GHC------ Marks - dots without anchor handles.------ \*\* WARNING \*\* - names are expected to change - filled and--- background-filled marks need a naming convention.--- -----------------------------------------------------------------------------------module Wumpus.Basic.Dots.Marks-  ( ---  -- * Marks-    markChar-  , markText--  , markHLine-  , markVLine-  , markX-  , markPlus-  , markCross-  , markDiamond-  , markFDiamond-  , markBDiamond -  , markDisk-  , markSquare-  , markCircle  -  , markPentagon-  , markStar-  , markAsterisk-  , markOPlus-  , markOCross-  , markFOCross---  ) where---import Wumpus.Basic.Graphic-import Wumpus.Basic.Text.LRText--import Wumpus.Core                      -- package: wumpus-core--import Data.AffineSpace                 -- package: vector-space-import Data.VectorSpace--import Control.Applicative-import Data.List---- Marks should be the height of a lower-case letter...---- NOTES------ TikZ has both stroked and bordered (filled and outline-stroked)--- marks e.g. square and square*-------- | 'polygonPoints' : @ num_points * radius * center -> [point] @ ----polygonPoints :: Floating u => Int -> u -> Point2 u -> [Point2 u]-polygonPoints n radius ctr = unfoldr phi (0,(pi*0.5))-  where-    theta = (pi*2) / fromIntegral n-    -    phi (i,ang) | i < n     = Just (ctr .+^ avec ang radius, (i+1,ang+theta))-                | otherwise = Nothing-----shiftOrigin :: Num u => u -> u -> LocGraphic u -> LocGraphic u-shiftOrigin dx dy = prepro1 (displace dx dy)--markChar :: (Fractional u, Ord u, FromPtSize u) => Char -> LocGraphic u-markChar ch = markText [ch]-----markText :: (Fractional u, Ord u, FromPtSize u) => String -> LocGraphic u-markText ss = postpro1 (\(_,b) -> b) $ singleLineCC ss-------- | Supplied point is the center.----axialLine :: Fractional u => Vec2 u -> LocGraphic u-axialLine v = localPoint (\ctr -> ctr .-^ (0.5 *^ v)) (straightLine v)---markHLine :: (Fractional u, FromPtSize u) => LocGraphic u -markHLine = bind1 (static1 markHeight) $ \h -> axialLine (hvec h)---markVLine :: (Fractional u, FromPtSize u) => LocGraphic u -markVLine = bind1 (static1 markHeight) $ \h -> axialLine (vvec h) ---markX :: (Fractional u, FromPtSize u) => LocGraphic u-markX = bind1 (static1 markHeight) $ \h -> -    let w = 0.75 * h in axialLine (vec w h) `oplus` axialLine (vec (-w) h)----markPlus :: (Fractional u, FromPtSize u) =>  LocGraphic u-markPlus = markVLine `oplus` markHLine---markCross :: (Floating u, FromPtSize u) =>  LocGraphic u-markCross = bind1 (static1 markHeight) $ \h ->  -    (axialLine $ avec ang h) `oplus` (axialLine $ avec (-ang) h)-  where-    ang = pi*0.25  ---- needs horizontal pinch...--pathDiamond :: (Fractional u, FromPtSize u) -            => LocCF u (PrimPath u)-pathDiamond = bind1 (static1 markHeight) $ \h -> promote1 $ \pt ->-    let hh    = 0.66 * h; hw = 0.5 * h -        s     = pt .+^ vvec (-hh)-        e     = pt .+^ hvec hw-        n     = pt .+^ vvec hh-        w     = pt .+^ hvec (-hw)-    in pure $ vertexPath [s,e,n,w]----- closedStroke :: (a -> ctx -> prim) --- pathDiamond  :: (ctx -> pt -> a)--- ans          :: (ctx -> pt -> prim)--markDiamond :: (Fractional u, FromPtSize u) => LocGraphic u-markDiamond = pathDiamond `bind1` (static1 . closedStroke)--markFDiamond :: (Fractional u, FromPtSize u) => LocGraphic u-markFDiamond = pathDiamond `bind1` (static1 . filledPath)----- Note - the (const . fn) composition doesn\'t /tell/ much about--- what is going on - though obviously it can be decoded - make --- the function obvious to the second argument. --- --- A named combinator might be better.-----markBDiamond :: (Fractional u, FromPtSize u) => LocGraphic u-markBDiamond = pathDiamond `bind1` (static1 . borderedPath)----- | Note disk is filled.----markDisk :: (Fractional u, FromPtSize u) => LocGraphic u-markDisk = bind1 (static1 markHalfHeight) filledDisk ----markSquare :: (Fractional u, FromPtSize u) => LocGraphic u-markSquare = bind1 (static1 markHeight) $ \h -> -    let d = 0.5*(-h) in shiftOrigin d d $ strokedRectangle h h-    ---markCircle :: (Fractional u, FromPtSize u) => LocGraphic u-markCircle = bind1 (static1 markHalfHeight) strokedDisk ---markBCircle :: (Fractional u, FromPtSize u) => LocGraphic u-markBCircle = bind1 (static1 markHalfHeight) borderedDisk ----markPentagon :: (Floating u, FromPtSize u) => LocGraphic u-markPentagon = bind1 (static1 markHeight) $ \h ->-    promote1 $ \pt -> closedStroke $ vertexPath $ polygonPoints 5 (0.5*h) pt-- ---markStar :: (Floating u, FromPtSize u) => LocGraphic u -markStar = bind1 (static1 markHeight) $ \h -> -    promote1 $ \pt -> let ps = polygonPoints 5 (0.5*h) pt in step $ map (fn pt) ps-  where-    fn st p1    = openStroke $ primPath st [lineTo p1] -    step (x:xs) = oconcat x xs-    step _      = error "markStar - unreachable"----- Note - relies on the functional instance of OPlus--markAsterisk :: (Floating u, FromPtSize u) => LocGraphic u-markAsterisk = bind1 (static1 markHeight) $ \h -> -    lineF1 h `oplus` lineF2 h `oplus` lineF3 h-  where-    ang       = (pi*2) / 6-    lineF1 z  = axialLine (vvec z)-    lineF2 z  = axialLine (avec ((pi*0.5) + ang)    z)-    lineF3 z  = axialLine (avec ((pi*0.5) + ang + ang) z)----markOPlus :: (Fractional u, FromPtSize u) => LocGraphic u-markOPlus = markCircle `oplus` markPlus---markOCross :: (Floating u, FromPtSize u) => LocGraphic u-markOCross = markCircle `oplus` markCross---markFOCross :: (Floating u, FromPtSize u) => LocGraphic u-markFOCross = markCross `oplus` markBCircle ----- bkCircle :: (Fractional u, FromPtSize u) => LocGraphic u--- bkCircle = disk (fillAttr attr) (0.5*markHeight attr) -

@@ -1,458 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module      :  Wumpus.Basic.DrawingComposition--- Copyright   :  (c) Stephen Tetley 2010--- License     :  BSD3------ Maintainer  :  stephen.tetley@gmail.com--- Stability   :  unstable--- Portability :  GHC------ Composition operators for Drawings.------ Note - some operations can produce empty drawings...--------------------------------------------------------------------------------------module Wumpus.Basic.DrawingComposition-  (-  -- * Composition-    over -  , under--  , centric-  , nextToH-  , nextToV-  -  , atPoint -  , centeredAt--  , zconcat--  , hcat -  , vcat---  , hspace-  , vspace-  , hsep-  , vsep- -  -- * Compose with alignment-  , alignH-  , alignV-  , alignHSep-  , alignVSep-  , hcatA-  , vcatA-  , hsepA-  , vsepA---  ) where--import Wumpus.Basic.Graphic--import Wumpus.Core                              -- package: wumpus-core--import Data.AdditiveGroup-import Data.AffineSpace--import Data.List ( foldl' )--------------------------------------------------------------------------------------- Extract anchors--boundaryExtr :: (BoundingBox u -> a) -> Picture u -> a-boundaryExtr f = f . boundary---- Operations on bounds---- | The center of a picture.----boundaryCenter :: Fractional u => Picture u -> Point2 u-boundaryCenter = boundaryExtr center------ | Extract the mid point of the top edge.----boundaryN :: Fractional u => Picture u -> Point2 u-boundaryN = boundaryExtr north---- | Extract the mid point of the bottom edge.----boundaryS :: Fractional u => Picture u -> Point2 u-boundaryS = boundaryExtr south---- | Extract the mid point of the left edge.----boundaryE :: Fractional u => Picture u -> Point2 u-boundaryE = boundaryExtr east---- | Extract the mid point of the right edge.----boundaryW :: Fractional u => Picture u -> Point2 u-boundaryW = boundaryExtr west----- | Extract the top-left corner.----boundaryNW :: Fractional u => Picture u -> Point2 u-boundaryNW = boundaryExtr northwest---- | Extract the top-right corner.----boundaryNE :: Picture u -> Point2 u-boundaryNE = boundaryExtr ur_corner---- | Extract the bottom-left corner.----boundarySW :: Picture u -> Point2 u-boundarySW = boundaryExtr ll_corner---- | Extract the bottom-right corner.----boundarySE :: Fractional u => Picture u -> Point2 u-boundarySE = boundaryExtr southeast---boundaryLeftEdge :: Picture u -> u-boundaryLeftEdge = boundaryExtr (point_x . ll_corner)--boundaryRightEdge :: Picture u -> u-boundaryRightEdge = boundaryExtr (point_x . ur_corner)--boundaryBottomEdge :: Picture u -> u-boundaryBottomEdge = boundaryExtr (point_y . ll_corner)---boundaryTopEdge :: Picture u -> u-boundaryTopEdge = boundaryExtr (point_y . ur_corner)-----  --- Note - do not export the empty drawing. It is easier to --- pretend it doesn't exist.--- -empty_drawing :: (Real u, Floating u, FromPtSize u) => Drawing u-empty_drawing = drawTracing $ return ()--------------------------------------------------------------------------------------- Composition operators---- Note - the megaCombR operator is in some way an--- /anti-combinator/. It seems easier to think about composing --- drawings if we do work on the result Pictures directly rather --- than build combinators to manipulate Drawings.------ The idea of combining pre- and post- operating combinators--- makes me worry about circular programs even though I know --- lazy evaluation allows me to write them (in some cicumstances).-------- Picture /mega-combiner/ - moves only the second argument aka the --- right picture.----megaCombR :: (Num u, Ord u)-          => (Picture u -> a) -> (Picture u -> a) -          -> (a -> a -> Picture u -> Picture u) -          -> Drawing u -> Drawing u-          -> Drawing u-megaCombR qL qR trafoR = drawingConcat fn-  where-    fn pic1 pic2 = let a    = qL pic1-                       b    = qR pic2-                       p2   = trafoR a b pic2-                   in pic1 `picOver` p2------- | > a `over` b--- --- Place \'drawing\' a over b. The idea of @over@ here is in --- terms z-ordering, nither picture a or b are actually moved.----over    :: (Num u, Ord u) => Drawing u -> Drawing u -> Drawing u-over    = drawingConcat picOver------ | > a `under` b------ Similarly @under@ draws the first drawing behind --- the second but move neither.----under :: (Num u, Ord u) => Drawing u -> Drawing u -> Drawing u-under = flip over------ | Move in both the horizontal and vertical.----move :: (Num u, Ord u) => Vec2 u -> Drawing u -> Drawing u-move v = modifyDrawing (\p -> p `picMoveBy` v)---------------------------------------------------------------------------------------- Composition--infixr 5 `nextToV`-infixr 6 `nextToH`, `centric`------- | Draw @a@, move @b@ so its center is at the same center as --- @a@, @b@ is drawn over underneath in the zorder.------ > a `centeric` b -------centric :: (Fractional u, Ord u) => Drawing u -> Drawing u -> Drawing u-centric = megaCombR boundaryCenter boundaryCenter moveFun-  where-    moveFun p1 p2 pic =  let v = p1 .-. p2 in pic `picMoveBy` v------ | > a `nextToH` b--- --- Horizontal composition - move @b@, placing it to the right --- of @a@.--- -nextToH :: (Num u, Ord u) => Drawing u -> Drawing u -> Drawing u-nextToH = megaCombR boundaryRightEdge boundaryLeftEdge moveFun-  where -    moveFun a b pic = pic `picMoveBy` hvec (a - b)------ | > a `nextToV` b------ Vertical composition - move @b@, placing it below @a@.----nextToV :: (Num u, Ord u) => Drawing u -> Drawing u -> Drawing u-nextToV = megaCombR boundaryBottomEdge boundaryTopEdge moveFun-  where -    moveFun a b drw = drw `picMoveBy` vvec (a - b)----- | Place the picture at the supplied point.------ `atPoint` was previous the `at` operator.--- -atPoint :: (Num u, Ord u) => Drawing u -> Point2 u  -> Drawing u-p `atPoint` (P2 x y) = move (V2 x y) p------ | Center the picture at the supplied point.----centeredAt :: (Fractional u, Ord u) => Drawing u -> Point2 u -> Drawing u-centeredAt d (P2 x y) = modifyDrawing fn d-  where-    fn p = let bb = boundary p-               dx = x - (boundaryWidth  bb * 0.5)-               dy = y - (boundaryHeight bb * 0.5)-           in p `picMoveBy` vec dx dy----- | Concatenate the list of drawings. ------ No pictures are moved. ----zconcat :: (Real u, Floating u, FromPtSize u) => [Drawing u] -> Drawing u-zconcat []     = empty_drawing-zconcat (d:ds) = foldl' over d ds------- | Concatenate the list pictures @xs@ horizontally.--- -hcat :: (Real u, Floating u, FromPtSize u) => [Drawing u] -> Drawing u-hcat []     = empty_drawing-hcat (d:ds) = foldl' nextToH d ds----- | Concatenate the list of pictures @xs@ vertically.----vcat :: (Real u, Floating u, FromPtSize u) => [Drawing u] -> Drawing u-vcat []     = empty_drawing-vcat (d:ds) = foldl' nextToV d ds-------------------------------------------------------------------------------------------- | > hspace n a b------ Horizontal composition - move @b@, placing it to the right --- of @a@ with a horizontal gap of @n@ separating the pictures.----hspace :: (Num u, Ord u) => u -> Drawing u -> Drawing u -> Drawing u-hspace n = megaCombR boundaryRightEdge boundaryLeftEdge moveFun-  where-    moveFun a b pic = pic `picMoveBy` hvec (n + a - b)--    ------ | > vspace n a b------ Vertical composition - move @b@, placing it below @a@ with a--- vertical gap of @n@ separating the pictures.----vspace :: (Num u, Ord u) => u -> Drawing u -> Drawing u -> Drawing u-vspace n = megaCombR boundaryBottomEdge boundaryTopEdge moveFun-  where -    moveFun a b pic = pic `picMoveBy`  vvec (a - b - n)------ | > hsep n xs------ Concatenate the list of pictures @xs@ horizontally with --- @hspace@ starting at @x@. The pictures are interspersed with --- spaces of @n@ units.----hsep :: (Real u, Floating u, FromPtSize u) => u -> [Drawing u] -> Drawing u-hsep _ []     = empty_drawing-hsep n (d:ds) = foldl' (hspace n) d ds------ | > vsep n xs------ Concatenate the list of pictures @xs@ vertically with --- @vspace@ starting at @x@. The pictures are interspersed with --- spaces of @n@ units.----vsep :: (Real u, Floating u, FromPtSize u) => u -> [Drawing u] -> Drawing u-vsep _ []     = empty_drawing-vsep n (d:ds) = foldl' (vspace n) d ds-------------------------------------------------------------------------------------- Aligning pictures--alignMove :: (Num u, Ord u) => Point2 u -> Point2 u -> Picture u -> Picture u-alignMove p1 p2 pic = pic `picMoveBy` (p1 .-. p2)------ | > alignH align a b--- --- Horizontal composition - move @b@, placing it to the right --- of @a@ and align it with the top, center or bottom of @a@.--- -alignH :: (Fractional u, Ord u) -       =>  HAlign -> Drawing u -> Drawing u -> Drawing u-alignH HTop     = megaCombR boundaryNE    boundaryNW     alignMove-alignH HCenter  = megaCombR boundaryE    boundaryW     alignMove-alignH HBottom  = megaCombR boundarySE boundarySW  alignMove----- | > alignV align a b--- --- Vertical composition - move @b@, placing it below @a@ --- and align it with the left, center or right of @a@.--- -alignV :: (Fractional u, Ord u) -       => VAlign -> Drawing u -> Drawing u -> Drawing u-alignV VLeft    = megaCombR boundarySW  boundaryNW   alignMove-alignV VCenter  = megaCombR boundaryS   boundaryN    alignMove-alignV VRight   = megaCombR boundarySE boundaryNE  alignMove----alignMove2 :: (Num u, Ord u) -           => Vec2 u ->  Point2 u -> Point2 u -> Picture u -> Picture u-alignMove2 v p1 p2 pic = pic `picMoveBy` (v ^+^ (p1 .-. p2))------ | > alignHSep align sep a b--- --- Spacing version of alignH - move @b@ to the right of @a@ --- separated by @sep@ units, align @b@ according to @align@.--- -alignHSep :: (Fractional u, Ord u) -          => HAlign -> u -> Drawing u -> Drawing u -> Drawing u-alignHSep HTop    dx = megaCombR boundaryNE boundaryNW (alignMove2 (hvec dx))-alignHSep HCenter dx = megaCombR boundaryE  boundaryW  (alignMove2 (hvec dx))-alignHSep HBottom dx = megaCombR boundarySE boundarySW (alignMove2 (hvec dx))----- | > alignVSep align sep a b--- --- Spacing version of alignV - move @b@ below @a@ --- separated by @sep@ units, align @b@ according to @align@.--- -alignVSep :: (Fractional u, Ord u) -          => VAlign -> u -> Drawing u -> Drawing u -> Drawing u-alignVSep VLeft   dy = megaCombR boundarySW boundaryNW (alignMove2 $ vvec (-dy)) -alignVSep VCenter dy = megaCombR boundaryS  boundaryN  (alignMove2 $ vvec (-dy)) -alignVSep VRight  dy = megaCombR boundarySE boundaryNE (alignMove2 $ vvec (-dy))----- | Variant of 'hcat' that aligns the pictures as well as--- concatenating them.----hcatA :: (Real u, Floating u, FromPtSize u) -      => HAlign -> [Drawing u] -> Drawing u-hcatA _  []     = empty_drawing-hcatA ha (d:ds) = foldl' (alignH ha) d ds------ | Variant of 'vcat' that aligns the pictures as well as--- concatenating them.----vcatA :: (Real u, Floating u, FromPtSize u) -      => VAlign -> [Drawing u] -> Drawing u-vcatA _  []     = empty_drawing-vcatA va (d:ds) = foldl' (alignV va) d ds----- | Variant of @hsep@ that aligns the pictures as well as--- concatenating and spacing them.----hsepA :: (Real u, Floating u, FromPtSize u) -      => HAlign -> u -> [Drawing u] -> Drawing u-hsepA _  _ []     = empty_drawing-hsepA ha n (d:ds) = foldl' op d ds-  where -    a `op` b = alignHSep ha n a b ----- | Variant of @vsep@ that aligns the pictures as well as--- concatenating and spacing them.----vsepA :: (Real u, Floating u, FromPtSize u) -      => VAlign -> u -> [Drawing u] -> Drawing u-vsepA _  _ []     = empty_drawing-vsepA va n (d:ds) = foldl' op d ds-  where -    a `op` b = alignVSep va n a b ---

@@ -1,62 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module      :  Wumpus.Basic.FontLoader.AfmLoader--- Copyright   :  (c) Stephen Tetley 2010--- License     :  BSD3------ Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable--- Portability :  GHC------ Font loader for the Adobe \"Core 14\" glyph metrics.------ Use this loader if you have the Adode glyph metrics set--- (AFM v4.1). This metrics set is avaiable from the Adobe --- website.--------------------------------------------------------------------------------------module Wumpus.Basic.FontLoader.AfmLoader-  ( --    module Wumpus.Basic.FontLoader.Base-  , module Wumpus.Basic.FontLoader.AfmV4Dot1Parser  --  , loadAfmMetrics-  , afmV4Dot1Loader-  --  -  ) where--import Wumpus.Basic.FontLoader.AfmV4Dot1Parser-import Wumpus.Basic.FontLoader.Base-import Wumpus.Basic.Graphic--import Wumpus.Core                              -- package: wumpus-core----loadAfmMetrics :: FilePath -> [FontName] -> IO BaseGlyphMetrics-loadAfmMetrics font_dir_path ns = -    loadBaseGlyphMetrics (afmV4Dot1Loader font_dir_path) ns---afmV4Dot1Loader :: FilePath -> FontLoader AfmUnit-afmV4Dot1Loader font_dir_path = -    FontLoader -      { unit_scale_fun      = afmUnitScale-      , path_to_font_dir    = font_dir_path-      , file_name_locator   = buildName-      , font_parser         = parseAfmV4Dot1File-      , post_process        = buildGlyphMetricsTable bbox (V2 600 0) 1000-      }-  where-    buildName :: FontName -> FilePath-    buildName font = font ++ ".afm"--    bbox           = BBox (P2 (-23) (-250)) (P2 715 805)--

@@ -1,215 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module      :  Wumpus.Basic.FontLoader.AfmParserBase--- Copyright   :  (c) Stephen Tetley 2010--- License     :  BSD3------ Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable--- Portability :  GHC------ Common parsers for AFM files.--- -----------------------------------------------------------------------------------module Wumpus.Basic.FontLoader.AfmParserBase-  ( --    afmFileParser-  , runQuery-  , textQuery--  , getFontBBox-  , getEncodingScheme-  , getCapHeight-  -  , charBBox-  , metric-  , keyStringPair-  , versionNumber  -  , startCharMetrics--  , keyName-  , newlineOrEOF-  , name-  , name1-  , semi-  , uptoNewline-  , number-  , cint-  , hexInt-  , octInt--  , lexeme-  , symbol-  , integer-  , int-  , double--  ) where--import Wumpus.Basic.FontLoader.Base-import Wumpus.Basic.Utils.ParserCombinators-import qualified Wumpus.Basic.Utils.TokenParsers as P--import Wumpus.Core                              -- package: wumpus-core--import Control.Applicative--import Data.Char-import qualified Data.Map               as Map----afmFileParser :: CharParser AfmGlyphMetrics -> CharParser AfmFile-afmFileParser pgm = do -    info <- (versionNumber    *> globalInfo) -    cms  <- (startCharMetrics *> many pgm)-    let mb_encoding = getEncodingScheme info-    let mb_cap      = getCapHeight      info-    let mb_bbox     = getFontBBox       info-    case mb_bbox of-      Nothing -> throwError "No FontBBox field in the AFM file."-      Just bb -> return $ AfmFile -                            { afm_encoding        = mb_encoding-                            , afm_font_bbox       = bb-                            , afm_cap_height      = mb_cap-                            , afm_glyph_metrics   = cms-                            }--globalInfo :: CharParser GlobalInfo-globalInfo = (foldr (\(k,v) a -> Map.insert k v a) Map.empty) -               <$> manyTill keyStringPair (peek startCharMetrics)--- -runQuery :: String -> CharParser a -> GlobalInfo -> Maybe a-runQuery field_name p table = -    Map.lookup field_name table >>= extr . runParser p-  where-    extr (Okay a _) = Just a-    extr _          = Nothing--textQuery :: String -> GlobalInfo -> Maybe String-textQuery = Map.lookup----- | Strictly speaking a fontBBox is measured in integer units.----getFontBBox            :: GlobalInfo -> Maybe AfmBoundingBox-getFontBBox            = runQuery "FontBBox" fontBBox--getEncodingScheme      :: GlobalInfo -> Maybe String-getEncodingScheme      = textQuery "EncodingScheme"--getCapHeight           :: GlobalInfo -> Maybe AfmUnit-getCapHeight           = runQuery "CapHeight" number---charBBox :: CharParser AfmBoundingBox-charBBox = symbol "B" *> fontBBox <* semi--fontBBox :: CharParser AfmBoundingBox-fontBBox = (\llx lly urx ury -> boundingBox (P2 llx lly) (P2 urx ury))-              <$> number <*> number <*> number <*> number----metric :: String -> a -> CharParser a -> CharParser a-metric iden dfault p = option dfault go-  where-    go = symbol iden *> p <* semi----keyStringPair :: CharParser (AfmKey,String)-keyStringPair = (,) <$> keyName <*> uptoNewline <* newlineOrEOF -             <?> "key-value line"--versionNumber :: CharParser String-versionNumber = -    symbol "StartFontMetrics" *> many1 (digit <|> char '.') <* newlineOrEOF-      <?> "StartFontMetrics"---startCharMetrics :: CharParser Int-startCharMetrics = symbol "StartCharMetrics" *> int <* newlineOrEOF-                <?> "StartCharMetrics failed"---------------------------------------------------------------------------------------keyName :: CharParser AfmKey-keyName = lexeme (many1 $ satisfy isAlphaNum) ---newlineOrEOF :: CharParser ()-newlineOrEOF = skipOne (lexeme newline) <|> eof---uptoNewline :: CharParser String-uptoNewline = many1 (noneOf ['\n'])---name :: CharParser String-name = lexeme $ many (noneOf ";\n")--name1 :: CharParser String-name1 = lexeme $ many (noneOf "; \t\n")----semi :: CharParser Char-semi = lexeme $ char ';'-----number :: CharParser AfmUnit-number = liftA realToFrac double---cint :: CharParser Int-cint = hexInt <|> octInt <|> int---hexInt :: CharParser Int-hexInt = lexeme $ between (char '<') (char '>') P.hexBase---octInt :: CharParser Int-octInt = lexeme $ char '\\' *> P.octBase---------------------------------------------------------------------------------------- no newline in whitespace---lp :: P.LexemeParser-lp = P.commentLineLexemeParser "Comment" [' ', '\t']---lexeme          :: CharParser a -> CharParser a-lexeme          = P.lexeme lp--symbol          :: String -> CharParser String-symbol          = lexeme . string---- whiteSpace      :: CharParser ()--- whiteSpace      = P.whiteSpace lp---integer         :: CharParser Integer-integer         = lexeme P.integer--int             :: CharParser Int-int             = fromIntegral <$> integer--double          :: CharParser Double-double          = lexeme P.double

@@ -1,67 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module      :  Wumpus.Basic.FontLoader.AfmV2--- Copyright   :  (c) Stephen Tetley 2010--- License     :  BSD3------ Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable--- Portability :  GHC------ AFM file parser for Version 2.0.------ Note - AFM Version 2.0 used by GhostScript and Version 3.0+--- have numerous differences. --- -----------------------------------------------------------------------------------module Wumpus.Basic.FontLoader.AfmV2Parser-  ( --     parseAfmV2File-  -  ) where--import Wumpus.Basic.FontLoader.AfmParserBase-import Wumpus.Basic.FontLoader.Base-import Wumpus.Basic.Utils.ParserCombinators--import Wumpus.Core                              -- package: wumpus-core--import Control.Applicative---------------------------------------------------------------------------------------- parser--parseAfmV2File :: FilePath -> IO (Either ParseError AfmFile)-parseAfmV2File filepath = runParserEither p <$> readFile filepath-  where-    p = afmFileParser charMetricsV2---charMetricsV2 :: CharParser AfmGlyphMetrics-charMetricsV2 = AfmGlyphMetrics <$>-        metric "C" (-1) cint-    <*> widthVector-    <*> metric "N" "" name1-    <*  charBBox-    <*  many (symbol "L" *> ligature_body <* semi)-    <*  newlineOrEOF-  where-    ligature_body = ((,) <$> name <*> name)-    -widthVector :: CharParser (Vec2 AfmUnit)-widthVector =  (symbol "WX" *> ((\w -> vec w 0) <$> number) <* semi)-           <|> (symbol "W"  *> (vec <$> number <*> number)  <* semi)---------------------------------------------------------------------------------------

@@ -1,67 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module      :  Wumpus.Basic.FontLoader.AfmV4Dot1Parser--- Copyright   :  (c) Stephen Tetley 2010--- License     :  BSD3------ Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable--- Portability :  GHC------ AFM file parser for Version 4.1.------ Adobe distributes font metrics for the /Core 14/ fonts as--- AFM Version 4.1 files.  --------------------------------------------------------------------------------------module Wumpus.Basic.FontLoader.AfmV4Dot1Parser-  ( -    -    parseAfmV4Dot1File-  -  ) where--import Wumpus.Basic.FontLoader.AfmParserBase-import Wumpus.Basic.FontLoader.Base-import Wumpus.Basic.Utils.ParserCombinators--import Wumpus.Core                              -- package: wumpus-core--import Control.Applicative---parseAfmV4Dot1File :: FilePath -> IO (Either ParseError AfmFile)-parseAfmV4Dot1File filepath = runParserEither p <$> readFile filepath-  where-    p = afmFileParser charMetricsV4Dot1----charMetricsV4Dot1 :: CharParser AfmGlyphMetrics-charMetricsV4Dot1 = AfmGlyphMetrics <$>-        characterCode-    <*> widthVector-    <*> metric "N" "" name1-    <*  charBBox-    <*  many (symbol "L" *> ligature_body <* semi)-    <*  newlineOrEOF-  where-    ligature_body = ((,) <$> name <*> name)----- Note - there are many variants for width vectors in in 4.1.--- Wumpus needs some thought about what to do for them, it also--- needs some facility to tell how successful the parse has been.-    -widthVector :: CharParser (Vec2 AfmUnit)-widthVector =  (symbol "WX" *> ((\w -> vec w 0) <$> number) <* semi)-           <|> (symbol "W"  *> (vec <$> number <*> number)  <* semi)----- V4.1 allows C int or CH \<hex\>----characterCode :: CharParser Int-characterCode = metric "CH" (-1) hexInt <|> metric "C" (-1) cint  

@@ -1,222 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ExistentialQuantification  #-}-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module      :  Wumpus.Basic.FontLoader.AfmV2--- Copyright   :  (c) Stephen Tetley 2010--- License     :  BSD3------ Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable--- Portability :  GHC------ AFM file parser.------ Note - AFM Version 2.0 used by GhostScript and Version 3.0+--- have numerous differences. --- -----------------------------------------------------------------------------------module Wumpus.Basic.FontLoader.Base-  (--  -- * Afm Unit-    AfmUnit-  , afmValue-  , afmUnitScale-  -  -- * Glyph metrics--  , PSCharCode-  , PSEncodingScheme-  , AfmBoundingBox--  , AfmKey-  , GlobalInfo-  , AfmFile(..)-  , AfmGlyphMetrics(..)--  -- * Font loading-  , FontLoadErr-  , FontLoadResult-  , FontLoader(..)-  , loadFont--  , BaseGlyphMetrics-  , loadBaseGlyphMetrics--  , buildGlyphMetricsTable--  ) where--import Wumpus.Basic.Graphic---import Wumpus.Core                              -- package: wumpus-core-import Wumpus.Core.Text.GlyphIndices--import Data.Foldable ( foldrM )-import qualified Data.IntMap            as IntMap-import qualified Data.Map as Map-import Data.Maybe--import System.Directory-import System.FilePath------ | Wrapped Double representing 1\/1000 of the scale factor--- (Point size) of a font. AFM files encode all measurements --- as these units. --- -newtype AfmUnit = AfmUnit { getAfmUnit :: Double } -  deriving (Eq,Ord,Num,Floating,Fractional,Real,RealFrac,RealFloat)--instance Show AfmUnit where-  showsPrec p d = showsPrec p (getAfmUnit d)----- | Compute the size of a measurement in Afm units scaled by the--- point size of the font.----afmValue :: FromPtSize u => AfmUnit -> PtSize -> u-afmValue u pt = fromPtSize $ (realToFrac $ getAfmUnit u) * (pt / 1000)--afmUnitScale :: AfmUnit -> PtSize -afmUnitScale u = (realToFrac $ getAfmUnit u / 1000)--------------------------------------------------------------------------------------- | Afm files index glyphs by /PostScript character code/. This --- is not the same as Unicode, ASCII...------ It is expected to be determined by @EncodingScheme@ in the--- Global Font Information Section.----type PSCharCode         = Int--type PSEncodingScheme   = String--type AfmBoundingBox     = BoundingBox AfmUnit--type AfmKey         = String-type GlobalInfo     = Map.Map AfmKey String------ | Wumpus needs a very small subset of AFM files, common to both--- version 2.0 and version 4.1.------ Note - Bounding Box is mandatory for AFM versions 3.0 and 4.1--- --- Cap Height is optional in AFM versions 3.0 and 4.1. As Wumpus --- uses cap height in calculations, glyph metrics must be build --- with an arbitrary value if it is not present.------ Encoding Scheme is optional in AFM files.----data AfmFile = AfmFile -      { afm_encoding        :: Maybe String-      , afm_font_bbox       :: AfmBoundingBox-      , afm_cap_height      :: Maybe AfmUnit-      , afm_glyph_metrics   :: [AfmGlyphMetrics]-      }-  deriving (Show) ---- Note BBox is a required field for version 4.1.---data AfmGlyphMetrics = AfmGlyphMetrics-      { afm_char_code       :: !PSCharCode-      , afm_width_vector    :: !(Vec2 AfmUnit)-      , afm_char_name       :: !String-      }-  deriving (Eq,Show)------ Maybe the CharMetricsTable should be scaled to Wumpus units as --- the last part of the parsing process...------ No it shouldn\'t - this would disallow drawings in centimeters--- --type FontLoadErr        = String-type FontLoadResult cu  = Either FontLoadErr (GlyphMetricsTable cu)--data FontLoader cu = forall interim. FontLoader -      { unit_scale_fun      :: cu -> PtSize-      , path_to_font_dir    :: FilePath-      , file_name_locator   :: FontName -> FilePath-      , font_parser         :: FilePath -> IO (Either String interim)-      , post_process        :: interim -> GlyphMetricsTable cu-      }---loadFont :: FontLoader cu -> FontName -> IO (FontLoadResult cu)-loadFont loader font_name = -    locateStep loader font_name >>= \ans -> case ans of-      Nothing        -> return $ Left $ "Cannot find font " ++ font_name-      Just full_path -> parseStep loader full_path--locateStep :: FontLoader cu -> FontName -> IO (Maybe FilePath)-locateStep loader font_name = -    doesFileExist full_path >>= \check -> -    if check then return $ Just full_path-             else return $ Nothing-  where-    full_path = normalise $ path_to_font_dir loader -                             </> file_name_locator loader font_name---parseStep :: FontLoader cu -> FilePath -> IO (FontLoadResult cu)-parseStep (FontLoader _ _ _ parser post) valid_path = -    fmap (either Left (Right . post)) $ parser valid_path--------------------------------------------------------------------------------------loadBaseGlyphMetrics :: FontLoader u -> [FontName] -> IO BaseGlyphMetrics-loadBaseGlyphMetrics loader xs = foldrM fn Map.empty xs-  where-    fn font_name acc = loadFont loader font_name >>= \ans -> -                       case ans of-                         Left err -> reportBaseError font_name err >> return acc-                         Right table -> return $ -                             Map.insert font_name (tableToGM table) acc--    tableToGM = buildMetrics (unit_scale_fun loader)  -    -reportBaseError :: FontName -> FontLoadErr -> IO ()-reportBaseError font_name err = do -    putStrLn $ "The font " ++ font_name ++ " failed to load, with the error:"-    putStrLn $ err-----buildGlyphMetricsTable :: BoundingBox AfmUnit -                       -> Vec2 AfmUnit -                       -> AfmUnit-                       -> AfmFile -                       -> GlyphMetricsTable AfmUnit-buildGlyphMetricsTable bbox dflt_vec dflt_cap_height afm = -    GlyphMetricsTable -      { glyph_bounding_box    = bbox-      , glyph_default_adv_vec = dflt_vec-      , glyph_adv_vecs        = makeAdvVecs $ afm_glyph_metrics afm-      , glyph_cap_height      = fromMaybe dflt_cap_height $ afm_cap_height afm-      }  ---makeAdvVecs :: [AfmGlyphMetrics] -> IntMap.IntMap (Vec2 AfmUnit)-makeAdvVecs  = foldr fn IntMap.empty-  where-    fn (AfmGlyphMetrics _ v ss) table = case Map.lookup ss ps_glyph_indices of-        Nothing -> table-        Just i  -> IntMap.insert i v table-