packages feed

wumpus-tree 0.14.0 → 0.15.0

raw patch · 9 files changed

+196/−198 lines, 9 filesdep ~wumpus-basicdep ~wumpus-coredep ~wumpus-drawingPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: wumpus-basic, wumpus-core, wumpus-drawing

API changes (from Hackage documentation)

- Wumpus.Tree.TreeBuildMonad: annotate :: u ~ (DUnit a) => NodeId a -> NodeAnno u -> TreeBuild u ()
+ Wumpus.Tree.ScalingContext: ScalingContext :: (ux -> u) -> (uy -> u) -> ScalingContext ux uy u
+ Wumpus.Tree.ScalingContext: coordinateScaling :: Num u => u -> u -> ScalingContext Int Int u
+ Wumpus.Tree.ScalingContext: data ScalingContext ux uy u
+ Wumpus.Tree.ScalingContext: scalePt :: ScalingContext ux uy u -> ux -> uy -> Point2 u
+ Wumpus.Tree.ScalingContext: scaleVec :: ScalingContext ux uy u -> ux -> uy -> Vec2 u
+ Wumpus.Tree.ScalingContext: scaleX :: ScalingContext ux uy u -> ux -> u
+ Wumpus.Tree.ScalingContext: scaleY :: ScalingContext ux uy u -> uy -> u
+ Wumpus.Tree.ScalingContext: scale_in_x :: ScalingContext ux uy u -> ux -> u
+ Wumpus.Tree.ScalingContext: scale_in_y :: ScalingContext ux uy u -> uy -> u
+ Wumpus.Tree.ScalingContext: uniformScaling :: Num u => u -> ScalingContext u u u
+ Wumpus.Tree.ScalingContext: unitX :: Num ux => ScalingContext ux uy u -> u
+ Wumpus.Tree.ScalingContext: unitY :: Num uy => ScalingContext ux uy u -> u
- Wumpus.Tree: charNode :: (Real u, Floating u, FromPtSize u) => Char -> TreeNode u
+ Wumpus.Tree: charNode :: (Real u, Floating u, InterpretUnit u) => Char -> TreeNode u
- Wumpus.Tree: circleNode :: (Floating u, FromPtSize u) => RGBi -> (a -> TreeNode u)
+ Wumpus.Tree: circleNode :: (Floating u, InterpretUnit u) => RGBi -> (a -> TreeNode u)
- Wumpus.Tree: diskNode :: (Floating u, FromPtSize u) => RGBi -> (a -> TreeNode u)
+ Wumpus.Tree: diskNode :: (Floating u, InterpretUnit u) => RGBi -> (a -> TreeNode u)
- Wumpus.Tree: drawScaledFamilyTree :: (Real u, Floating u, FromPtSize u, InnerSpace (Vec2 u)) => ScaleFactors u -> Point2 u -> TreeBuildAns u -> TreeDrawing u
+ Wumpus.Tree: drawScaledFamilyTree :: (Real u, Floating u, InterpretUnit u, InnerSpace (Vec2 u)) => ScaleFactors u -> Point2 u -> TreeBuildAns u -> TreeDrawing u
- Wumpus.Tree: drawScaledTree :: (Real u, Floating u, FromPtSize u, InnerSpace (Vec2 u)) => ScaleFactors u -> Point2 u -> TreeBuildAns u -> TreeDrawing u
+ Wumpus.Tree: drawScaledTree :: (Real u, Floating u, InterpretUnit u, InnerSpace (Vec2 u)) => ScaleFactors u -> Point2 u -> TreeBuildAns u -> TreeDrawing u
- Wumpus.Tree: drawScaledTreeD :: (Real u, Floating u, FromPtSize u, InnerSpace (Vec2 u)) => ScaleFactors u -> Point2 u -> TreeDirection -> TreeBuildAns u -> TreeDrawing u
+ Wumpus.Tree: drawScaledTreeD :: (Real u, Floating u, InterpretUnit u, InnerSpace (Vec2 u)) => ScaleFactors u -> Point2 u -> TreeDirection -> TreeBuildAns u -> TreeDrawing u
- Wumpus.Tree: textNode :: (Real u, Floating u, FromPtSize u) => String -> TreeNode u
+ Wumpus.Tree: textNode :: (Real u, Floating u, InterpretUnit u) => String -> TreeNode u
- Wumpus.Tree.Draw: drawFamilyTree :: (Real u, Floating u, FromPtSize u) => NodeAnnoRefs u -> CoordTree u (TreeNodeAns u) -> TreeDrawing u
+ Wumpus.Tree.Draw: drawFamilyTree :: (Real u, Floating u, InterpretUnit u) => NodeAnnoRefs u -> CoordTree u (TreeNodeAns u) -> TreeDrawing u
- Wumpus.Tree.Draw: drawTree :: (Real u, Floating u, FromPtSize u) => NodeAnnoRefs u -> CoordTree u (TreeNodeAns u) -> TreeDrawing u
+ Wumpus.Tree.Draw: drawTree :: (Real u, Floating u, InterpretUnit u) => NodeAnnoRefs u -> CoordTree u (TreeNodeAns u) -> TreeDrawing u
- Wumpus.Tree.TreeBuildMonad: runTreeBuild :: (Real u, Floating u, FromPtSize u) => (a -> TreeNode u) -> TreeBuild u (TreeSpec a) -> TreeBuildAns u
+ Wumpus.Tree.TreeBuildMonad: runTreeBuild :: (Real u, Floating u, InterpretUnit u) => (a -> TreeNode u) -> TreeBuild u (TreeSpec a) -> TreeBuildAns u

Files

demo/Demo01.hs view
@@ -17,76 +17,58 @@ import Wumpus.Tree import Wumpus.Tree.TreeBuildMonad +import Wumpus.Drawing.Colour.SVGColours         -- package: wumpus-drawing+import Wumpus.Drawing.Text.StandardFontDefs+ import Wumpus.Basic.Kernel                      -- package: wumpus-basic-import Wumpus.Basic.System.FontLoader.Afm-import Wumpus.Basic.System.FontLoader.GhostScript-import Wumpus.Drawing.Colour.SVGColours-import Wumpus.Drawing.Text.SafeFonts+import Wumpus.Basic.System.FontLoader  import Wumpus.Core                              -- package: wumpus-core -import FontLoaderUtils-- import Data.Tree hiding ( drawTree ) import System.Directory --- Note - @main@ prioritizes GhostScript metrics... - main :: IO ()-main = do -    (mb_gs, mb_afm) <- processCmdLine default_font_loader_help-    createDirectoryIfMissing True "./out/"-    case (mb_gs, mb_afm) of       -      (Just dir, _) -> do { putStrLn "Using GhostScript metrics..."-                          ; (metrics,msgs) <- loadGSMetrics  dir ["Times-Roman"]-                          ; mapM_ putStrLn msgs-                          ; makePictures metrics-                          }-      (_, Just dir) -> do { putStrLn "Using AFM v4.1 metrics..."-                          ; (metrics,msgs) <- loadAfmMetrics dir ["Times-Roman"]-                          ; mapM_ putStrLn msgs-                          ; makePictures metrics-                          }-      _             -> putStrLn default_font_loader_help-+main = simpleFontLoader main1 >> return () -makePictures :: GlyphMetrics -> IO ()-makePictures base_metrics = do +main1 :: FontLoader -> IO ()+main1 loader = do+    createDirectoryIfMissing True "./out/" +    base_metrics <- loader [ Right helvetica_family ]+    printLoadErrors base_metrics     let pic1 = runCtxPictureU (makeCtx 18 base_metrics) tree_pic1     writeEPS "./out/regular_tree01.eps"  pic1     writeSVG "./out/regular_tree01.svg"  pic1  --makeCtx :: FontSize -> GlyphMetrics -> DrawingContext-makeCtx sz m = fontFace times_roman $ metricsContext sz m+makeCtx :: FontSize -> FontLoadResult -> DrawingContext+makeCtx sz m = set_font times_roman $ metricsContext sz m   -tree_pic1 :: DCtxPicture-tree_pic1 = drawTracing $ do+tree_pic1 :: CtxPicture+tree_pic1 = udrawTracing (0::Double) $ do     ---    draw $ textline "Tree 1:"        `at` (P2 0  530)+    draw $ plainTextLine "Tree 1:"        `at` (P2 0  530)     drawScaledTree (uniformSF 30)         (P2 80 530) $         runTreeBuild charNode tree1     ---    draw $ textline "Tree 2:"       `at` (P2 160 530) +    draw $ plainTextLine "Tree 2:"       `at` (P2 160 530)      drawScaledTree (uniformSF 30)        (P2 240 530) $          runTreeBuild (diskNode red) tree2 -    draw $ textline "Tree 3:"       `at` (P2 0  410) -    localize (fontSize 12) $ +    draw $ plainTextLine "Tree 3:"       `at` (P2 0  410) +    localize (set_font_size 12) $          drawScaledFamilyTree (uniformSF 25) (P2 280 410) $            runTreeBuild charNode tree3      ---    draw $ textline "Tree 4:"       `at` (P2 0  200)+    draw $ plainTextLine "Tree 4:"       `at` (P2 0  200)     drawScaledTree (scaleFactors 20 30)  (P2 80 200) $          runTreeBuild (circleNode black) tree4     ---    draw $ textline "Tree 5:"        `at` zeroPt+    draw $ plainTextLine "Tree 5:"        `at` zeroPt     drawScaledTree (scaleFactors 20 30)  (P2 240 0) $         runTreeBuild (circleNode black)  tree5 
− demo/FontLoaderUtils.hs
@@ -1,95 +0,0 @@-{-# OPTIONS -Wall #-}---module FontLoaderUtils-  (-    processCmdLine-  , default_font_loader_help-  ) where---import Control.Applicative-import Control.Monad-import System.Directory-import System.Console.GetOpt-import System.Environment-import System.IO.Error---wumpus_gs_font_dir :: String-wumpus_gs_font_dir = "WUMPUS_GS_FONT_DIR"--wumpus_afm_font_dir :: String-wumpus_afm_font_dir = "WUMPUS_AFM_FONT_DIR"---default_font_loader_help :: String-default_font_loader_help = unlines $ -    [ "This example uses glyph metrics loaded at runtime."-    , "It can use either the metrics files supplied with GhostScript,"-    , "or the AFM v4.1 metrics for the Core 14 fonts available from"-    , "Adobe's website."-    , "" -    , "To use GhostScripts font metrics set the environemt variable"-    , wumpus_gs_font_dir ++ " to point to the GhostScript fonts"-    , "directory (e.g. /usr/share/ghostscript/fonts) or use the command"-    , "line flag --gs=PATH_TO_GHOSTSCRIPT_FONTS"-    , ""-    , "To use the Adode Core 14 font metrics download the archive from"-    , "the Adobe website and set the environment variable "-    , wumpus_afm_font_dir ++ " to point to it, or use the command line"-    , "flag -- afm=PATH_TO_AFM_CORE14_FONTS"-    ]---data CmdLineFlag = Help-                 | GS_FontDir  String-                 | AFM_FontDir String-  deriving (Eq,Ord,Show)--processCmdLine :: String -> IO (Maybe FilePath, Maybe FilePath)-processCmdLine help_message = -    let options = makeCmdLineOptions help_message in do-        args <- getArgs-        let (opts, _, _) = getOpt Permute options args-        if Help `elem` opts then failk help_message-                            else succk opts-  where-    failk msg   = putStr msg >> return (Nothing,Nothing) -    succk flags = (,) <$> gsFontDirectory flags <*> afmFontDirectory flags -       --makeCmdLineOptions :: String -> [OptDescr CmdLineFlag]-makeCmdLineOptions help_message =-    [ Option ['h'] ["help"]   (NoArg Help)                help_message-    , Option []    ["afm"]    (ReqArg AFM_FontDir "DIR")  "AFM v4.1 metrics dir"-    , Option []    ["gs"]     (ReqArg GS_FontDir  "DIR")  "GhoshScript font dir"-    ]---gsFontDirectory :: [CmdLineFlag] -> IO (Maybe FilePath)-gsFontDirectory = step -  where-    step (GS_FontDir p:xs)  = doesDirectoryExist p >>= \check -> -                              if check then return (Just p) else step xs--    step (_:xs)             = step xs-    step []                 = envLookup wumpus_gs_font_dir- --afmFontDirectory :: [CmdLineFlag] -> IO (Maybe FilePath)-afmFontDirectory = step -  where-    step (AFM_FontDir p:xs) = doesDirectoryExist p >>= \check -> -                              if check then return (Just p) else step xs--    step (_:xs)             = step xs-    step []                 = envLookup wumpus_afm_font_dir---envLookup :: String -> IO (Maybe String)-envLookup name = liftM fn $ try $ getEnv name-  where-    fn (Left _)  = Nothing-    fn (Right a) = Just a-
src/Wumpus/Tree.hs view
@@ -41,6 +41,7 @@ import Wumpus.Tree.Base import Wumpus.Tree.Design import Wumpus.Tree.Draw+import Wumpus.Tree.ScalingContext import Wumpus.Tree.TreeBuildMonad  import Wumpus.Basic.Kernel                      -- package: wumpus-basic@@ -66,7 +67,6 @@ -- type ScaleFactors u = ScalingContext u Int u -type instance DUnit (ScaleFactors u) = u   @@ -85,7 +85,7 @@  --  -drawScaledTree :: (Real u, Floating u, FromPtSize u, InnerSpace (Vec2 u)) +drawScaledTree :: (Real u, Floating u, InterpretUnit u, InnerSpace (Vec2 u))                 => ScaleFactors u -> Point2 u -> TreeBuildAns u                 -> TreeDrawing u drawScaledTree scale_f ogin (tree,annos) = @@ -96,7 +96,7 @@ data TreeDirection = TREE_UP | TREE_DOWN | TREE_LEFT | TREE_RIGHT   deriving (Eq,Ord,Show) -drawScaledTreeD :: (Real u, Floating u, FromPtSize u, InnerSpace (Vec2 u)) +drawScaledTreeD :: (Real u, Floating u, InterpretUnit u, InnerSpace (Vec2 u))                  => ScaleFactors u -> Point2 u                  -> TreeDirection -> TreeBuildAns u                  -> TreeDrawing u@@ -116,7 +116,7 @@   -drawScaledFamilyTree :: (Real u, Floating u, FromPtSize u, InnerSpace (Vec2 u)) +drawScaledFamilyTree :: (Real u, Floating u, InterpretUnit u, InnerSpace (Vec2 u))                 => ScaleFactors u -> Point2 u -> TreeBuildAns u                 -> TreeDrawing u drawScaledFamilyTree scale_f ogin (tree,annos) = @@ -129,7 +129,7 @@ -- --  Useful for rendering @ Data.Tree Char @. ---charNode :: (Real u, Floating u, FromPtSize u) +charNode :: (Real u, Floating u, InterpretUnit u)           => Char -> TreeNode u charNode = dotChar @@ -143,7 +143,7 @@ -- Also, only a single line of text is printed - any text after  -- the first newline character will be dropped. ---textNode :: (Real u, Floating u, FromPtSize u) +textNode :: (Real u, Floating u, InterpretUnit u)           => String -> TreeNode u textNode = dotText . uptoNewline   where@@ -153,18 +153,18 @@ -- -- Suitable for printing the shape of a tree, ignoring the data. ---circleNode :: (Floating u, FromPtSize u) +circleNode :: (Floating u, InterpretUnit u)             => RGBi -> (a -> TreeNode u)-circleNode rgb = \_ -> localize (strokeColour rgb) dotCircle+circleNode rgb = \_ -> localize (stroke_colour rgb) dotCircle   -- | Tree nodes with a filled circle. -- -- Suitable for printing the shape of a tree, ignoring the data. ---diskNode :: (Floating u, FromPtSize u) +diskNode :: (Floating u, InterpretUnit u)           => RGBi -> (a -> TreeNode u)-diskNode rgb = \_ -> localize (fillColour rgb) dotDisk+diskNode rgb = \_ -> localize (fill_colour rgb) dotDisk   
src/Wumpus/Tree/Design.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE ScopedTypeVariables        #-} {-# OPTIONS -Wall #-} @@ -32,8 +31,8 @@   where  import Wumpus.Tree.Base+import Wumpus.Tree.ScalingContext -import Wumpus.Basic.Kernel              -- package: wumpus-basic  import Wumpus.Core                      -- package: wumpus-core @@ -234,10 +233,12 @@     mv dx dy (Node (P2 x y, a) ks) = let ks' = map (mv dx dy) ks                                       in Node (P2 (x+dx) (y+dy), a) ks' -+-- Updating this to the latest Wumpus-Basic would make the +-- function a query...+-- rotateAboutRoot :: (Real u, Floating u)                  => Radian -> CoordTree u a -> CoordTree u a-rotateAboutRoot ang (Node (ogin,val) kids) =  +rotateAboutRoot ang (Node (ogin,val) kids) =     Node (ogin, val) $ map step kids   where     step (Node (p0, a) ks) = Node (rotA p0, a) $ map step ks
src/Wumpus/Tree/Draw.hs view
@@ -32,7 +32,6 @@ import Wumpus.Core                              -- package: wumpus-core  - import Control.Monad import qualified Data.IntMap as IntMap import Data.Tree hiding ( drawTree )@@ -40,13 +39,13 @@   -drawTree :: (Real u, Floating u, FromPtSize u) +drawTree :: (Real u, Floating u, InterpretUnit u)            => NodeAnnoRefs u -> CoordTree u (TreeNodeAns u) -> TreeDrawing u drawTree annos tree = drawStep annos radialConns tree >> return ()   -drawFamilyTree :: (Real u, Floating u, FromPtSize u) +drawFamilyTree :: (Real u, Floating u, InterpretUnit u)            => NodeAnnoRefs u -> CoordTree u (TreeNodeAns u) -> TreeDrawing u drawFamilyTree annos tree = drawStep annos familyConn tree >> return () @@ -70,22 +69,25 @@   -radialConns :: ( Real u, Floating u-               , CenterAnchor a, RadialAnchor a, u ~ DUnit a ) +radialConns :: ( Real u, Floating u, InterpretUnit u+               , CenterAnchor a, RadialAnchor a +               , u ~ DUnit a)              => a -> [a] -> Graphic u-radialConns a []            = emptyLocGraphic `at` center a-radialConns a (x:xs)        = oconcat (connector a x) (map (connector a) xs)+radialConns a []     = emptyLocGraphic `at` (center a)+radialConns a (x:xs) = oconcat (connector a x) (map (connector a) xs)   -connector :: ( Real u, Floating u-             , CenterAnchor a, RadialAnchor a, u ~ DUnit a )  +connector :: ( Real u, Floating u, InterpretUnit u+             , CenterAnchor a, RadialAnchor a+             , u ~ DUnit a )             => a -> a -> Graphic u-connector a1 a2 = openStroke $ vertexPath [p1,p2]-  where  -    (ang0,ang1)    = anchorAngles (center a1) (center a2)-    p1             = radialAnchor ang0 a1-    p2             = radialAnchor ang1 a2 +connector a0 a1 = vertexPP [pt0,pt1] >>= openStroke+  where+    (ang0,ang1) = anchorAngles (center a0) (center a1)+    pt0         = radialAnchor ang0 a0+    pt1         = radialAnchor ang1 a1+       @@ -106,26 +108,29 @@ -------------------------------------------------------------------------------- --  -familyConn :: ( Real u, Fractional u-              , CenterAnchor a, CardinalAnchor a, u ~ DUnit a ) +familyConn :: ( Real u, Fractional u, InterpretUnit u+              , CenterAnchor a, CardinalAnchor a +              , u ~ DUnit a )             => a -> [a] -> Graphic u-familyConn a []            = emptyLocGraphic `at` center a-familyConn a xs            = famconn (south a) (map north xs)+familyConn a [] = emptyLocGraphic `at` (center a)+familyConn a xs = famconn (south a) (map north xs) -famconn :: (Fractional u, Ord u) => Point2 u -> [Point2 u] -> Graphic u+famconn :: (Fractional u, Ord u, InterpretUnit u) +        => Point2 u -> [Point2 u] -> Graphic u famconn _       []         = error "famconn - empty list" famconn pt_from [p1]       = famconn1 pt_from p1 famconn pt_from xs@(p1:_)  = oconcat downtick (horizontal : upticks)    where      hh         = halfHeight pt_from p1-     downtick   = straightLine (vvec (-hh)) `at` pt_from+     downtick   = locStraightLine (vvec (-hh)) `at` pt_from      horizontal = midline (displaceV (-hh) pt_from) xs -     upticks    = map (straightLine (vvec hh) `at`) xs+     upticks    = map (locStraightLine (vvec hh) `at`) xs -midline :: (Fractional u, Ord u) => Point2 u -> [Point2 u] -> Graphic u+midline :: (Fractional u, Ord u, InterpretUnit u) +        => Point2 u -> [Point2 u] -> Graphic u midline _        []           = error "midline - empty list"  midline (P2 _ y) (P2 x0 _:zs) = -    let (a,b) = foldr fn (x0,x0) zs in straightLineGraphic (P2 a y) (P2 b y)+    let (a,b) = foldr fn (x0,x0) zs in straightLine (P2 a y) (P2 b y)   where        fn (P2 x _) (lo,hi) | x < lo    = (x,hi)                         | x > hi    = (lo,x)@@ -135,10 +140,12 @@ halfHeight (P2 _ ya) (P2 _ yb) = 0.5 * (abs $ ya - yb)   -- special case - should always be a vertical, but...-famconn1 :: Fractional u => Point2 u -> Point2 u -> Graphic u+--+famconn1 :: (Fractional u, InterpretUnit u)+         => Point2 u -> Point2 u -> Graphic u famconn1 a@(P2 xa _) b@(P2 xb _) -    | xa == xb  = straightLineGraphic a b-    | otherwise = openStroke $ vertexPath [a,m1,m2,b] +    | xa == xb  = straightLine a b+    | otherwise = vertexPP [a,m1,m2,b] >>= openStroke   where     hh = halfHeight a b     m1 = displaceV (-hh)     a  
+ src/Wumpus/Tree/ScalingContext.hs view
@@ -0,0 +1,103 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module      :  Wumpus.Tree.ScalingContext+-- Copyright   :  (c) Stephen Tetley 2010-2011+-- License     :  BSD3+--+-- Maintainer  :  stephen.tetley@gmail.com+-- Stability   :  unstable+-- Portability :  GHC+--+-- Scaling in X and Y+--+-- \*\* WARNING \*\* - to be removed at some point.+-- +--------------------------------------------------------------------------------++module Wumpus.Tree.ScalingContext+  (++    ScalingContext(..)++  , scaleX+  , scaleY+  , scalePt+  , scaleVec++  , unitX+  , unitY++  , uniformScaling+  , coordinateScaling++  ) where+++import Wumpus.Core				-- package: wumpus-core++++-- | ScalingContext is a dictionary of two functions for scaling +-- in X and Y.+--+data ScalingContext ux uy u = ScalingContext+      { scale_in_x  :: ux -> u+      , scale_in_y  :: uy -> u+      }+++scaleX              :: ScalingContext ux uy u -> ux -> u+scaleX ctx ux       = (scale_in_x ctx) ux++scaleY              :: ScalingContext ux uy u -> uy -> u+scaleY ctx uy       = (scale_in_y ctx) uy+++scalePt             :: ScalingContext ux uy u -> ux -> uy -> Point2 u+scalePt ctx ux uy   = P2 (scale_in_x ctx ux) (scale_in_y ctx uy)++scaleVec            :: ScalingContext ux uy u -> ux -> uy -> Vec2 u+scaleVec ctx ux uy  = V2 (scale_in_x ctx ux) (scale_in_y ctx uy)+++unitX               :: Num ux => ScalingContext ux uy u -> u+unitX ctx           = scaleX ctx 1+ +unitY               :: Num uy => ScalingContext ux uy u -> u+unitY ctx           = scaleY ctx 1+++++--------------------------------------------------------------------------------+-- constructors for scaling context+++-- | Build a ScalingContext where both X and Y are scaled by the +-- same uniform step.+--+-- The dimensions (types) of the ScalingContext are unified - the +-- output type and the input types are all the same.+--+uniformScaling :: Num u => u -> ScalingContext u u u+uniformScaling u = ScalingContext+      { scale_in_x  = (\x -> u*x)+      , scale_in_y  = (\y -> u*y)+      }++++-- | Build a ScalingContext for scaling Int coordinates.+--+-- The scaling factors in X and Y can be different sizes.+---+coordinateScaling :: Num u => u -> u -> ScalingContext Int Int u+coordinateScaling sx sy = ScalingContext+      { scale_in_x  = (\x -> sx * fromIntegral x)+      , scale_in_y  = (\y -> sy * fromIntegral y)+      }+++
src/Wumpus/Tree/TreeBuildMonad.hs view
@@ -4,7 +4,7 @@ -------------------------------------------------------------------------------- -- | -- Module      :  Wumpus.Tree.TreeBuildMonad--- Copyright   :  (c) Stephen Tetley 2010+-- Copyright   :  (c) Stephen Tetley 2010-2011 -- License     :  BSD3 -- -- Maintainer  :  stephen.tetley@gmail.com@@ -34,7 +34,6 @@    , nodeId   , label-  , annotate    , branch   , zbranch@@ -48,7 +47,6 @@ import Wumpus.Basic.Kernel                      -- package: wumpus-basic import Wumpus.Drawing.Dots.AnchorDots -import Wumpus.Core                              -- package: wumpus-core  import Control.Applicative import qualified Data.IntMap as IntMap@@ -89,7 +87,6 @@       , anno_refs       :: NodeAnnoRefs u       } -type instance DUnit (St u) = u  zeroSt :: St u zeroSt = St { uid_counter = 0, node_refs = mempty, anno_refs = mempty }@@ -112,11 +109,6 @@                                 in getTreeBuild (k a) s1   ---type instance MonUnit (TreeBuild u) = u-- type TreeSpec a   = Tree (NodeId a) type ZTreeSpec u  = TreeSpec (UNil u) @@ -131,8 +123,8 @@ -- monad is only significant for producing a @Tree (TreeNode u)@. -- -runTreeBuild :: (Real u, Floating u, FromPtSize u)-               => (a -> TreeNode u) -> TreeBuild u (TreeSpec a) -> TreeBuildAns u+runTreeBuild :: (Real u, Floating u, InterpretUnit u)+             => (a -> TreeNode u) -> TreeBuild u (TreeSpec a) -> TreeBuildAns u runTreeBuild regDrawF ma =      let (a,s) = getTreeBuild ma zeroSt         t1    = postRun regDrawF (a, node_refs s)@@ -145,7 +137,7 @@ -- unreachable we still need it in the code to make the  -- IntMap.lookup total. ---postRun :: (Real u, Floating u, FromPtSize u)+postRun :: (Real u, Floating u, InterpretUnit u)         => (a -> TreeNode u) -> (TreeSpec a,NodeDrawRefs u)          -> Tree (TreeNode u, Maybe Int) postRun regDrawF (tree1,table) = fmap changeNode tree1@@ -180,6 +172,7 @@ label a = RegularNode a  +{- -- | Annotate a /node/ with a 'NodeAnno'. --  -- Note - /regular/ nodes cannot be annotated, a node must be @@ -194,7 +187,7 @@     TreeBuild $ \(St ix nodes annos) ->        let annos' = IntMap.insert nid annoF annos       in ((), St ix nodes annos')-+-}   branch :: NodeId a -> [TreeSpec a] -> TreeSpec a@@ -204,7 +197,7 @@ -- | Default /branch/ - has children. -- zbranch :: [ZTreeSpec u] -> ZTreeSpec u-zbranch kids = Node (RegularNode uNil) kids +zbranch kids = Node (RegularNode UNil) kids   leaf :: NodeId a -> TreeSpec a leaf uid = Node uid []@@ -212,7 +205,7 @@ -- | Default /leaf/ - tree node with no children. -- zleaf :: ZTreeSpec u-zleaf = Node (RegularNode uNil) []+zleaf = Node (RegularNode UNil) []               
src/Wumpus/Tree/VersionNumber.hs view
@@ -22,7 +22,7 @@  -- | Version number ----- > (0,14,0)+-- > (0,15,0) -- wumpus_tree_version :: (Int,Int,Int)-wumpus_tree_version = (0,14,0)+wumpus_tree_version = (0,15,0)
wumpus-tree.cabal view
@@ -1,5 +1,5 @@ name:             wumpus-tree-version:          0.14.0+version:          0.15.0 license:          BSD3 license-file:     LICENSE copyright:        Stephen Tetley <stephen.tetley@gmail.com>@@ -21,7 +21,7 @@   available from Adode (AFM file version 4.1). To run the demos    properly you will need one of these sets of metrics.   .-  Adobe Font techinal notes:+  Adobe Font technical notes:   <https://www.adobe.com/devnet/font.html>   .   Core 14 AFM metrics:@@ -32,10 +32,17 @@   .   Changelog:   .-  v0.13.0 to v0.14.0:+  v0.14.0 to v0.15.0   .   * Updated to work with latest Wumpus libraries. +    @ScalingContext@ has been temporarily added from Wumpus-Basic +    (it was considered obsolete there). At some point the +    functionality needs re-implementing so it can be removed from +    Tree.+  .  +  v0.13.0 to v0.14.0:   .+  * Updated to work with latest Wumpus libraries.    .   v0.12.0 to v0.13.0:   .@@ -76,17 +83,16 @@ extra-source-files:   CHANGES,   LICENSE,-  demo/Demo01.hs,-  demo/FontLoaderUtils.hs+  demo/Demo01.hs    library   hs-source-dirs:     src   build-depends:      base              <  5,                        containers        >= 0.3.0     && <= 0.6.0,                       vector-space      >= 0.6       && <  1.0,-                      wumpus-core       >= 0.43.0    && <  0.44.0,-                      wumpus-basic      == 0.16.0,-                      wumpus-drawing    == 0.2.0+                      wumpus-core       >= 0.50.0    && <  0.51.0,+                      wumpus-basic      == 0.17.0,+                      wumpus-drawing    == 0.3.0       exposed-modules:@@ -94,6 +100,7 @@     Wumpus.Tree.Base,     Wumpus.Tree.Design,     Wumpus.Tree.Draw,+    Wumpus.Tree.ScalingContext,     Wumpus.Tree.TreeBuildMonad,     Wumpus.Tree.VersionNumber