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 +20/−38
- demo/FontLoaderUtils.hs +0/−95
- src/Wumpus/Tree.hs +10/−10
- src/Wumpus/Tree/Design.hs +5/−4
- src/Wumpus/Tree/Draw.hs +33/−26
- src/Wumpus/Tree/ScalingContext.hs +103/−0
- src/Wumpus/Tree/TreeBuildMonad.hs +8/−15
- src/Wumpus/Tree/VersionNumber.hs +2/−2
- wumpus-tree.cabal +15/−8
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