diff --git a/demo/Demo01.hs b/demo/Demo01.hs --- a/demo/Demo01.hs +++ b/demo/Demo01.hs @@ -1,51 +1,97 @@ {-# OPTIONS -Wall #-} +-- Note - @main@ is more convoluted than would normally be +-- expected as it supports both sources of glyph metrics - the +-- GhostScript distribution or the Core 14 metrics from Adobe. +-- +-- \"Real\" applications would be expected to choose one source. +-- +-- I-am-not-a-lawyer, but it does look as though the Adobe font +-- metrics are redistributable, the GhostScript metrics are +-- seemingly redistributable under the same terms as the larger +-- GhostScript distribution. +-- module Demo01 where import Wumpus.Tree import Wumpus.Basic.Colour.SVGColours -- package: wumpus-basic +import Wumpus.Basic.FontLoader.AfmLoader +import Wumpus.Basic.FontLoader.GSLoader import Wumpus.Basic.Graphic +import Wumpus.Basic.SafeFonts +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/" - writeEPS_TreePicture "./out/tree01.eps" pic1 - writeSVG_TreePicture "./out/tree01.svg" pic1 - writeEPS_TreePicture "./out/tree02.eps" pic2 - writeSVG_TreePicture "./out/tree02.svg" pic2 - writeEPS_TreePicture "./out/tree03.eps" pic3 - writeSVG_TreePicture "./out/tree03.svg" pic3 - writeEPS_TreePicture "./out/tree04.eps" pic4 - writeSVG_TreePicture "./out/tree04.svg" pic4 - writeEPS_TreePicture "./out/tree05.eps" pic5 - writeSVG_TreePicture "./out/tree05.svg" pic5 + case (mb_gs, mb_afm) of + (Just dir, _) -> do { putStrLn "Using GhostScript metrics..." + ; loadGSMetrics dir ["Times-Roman"] >>= makePictures + } + (_, Just dir) -> do { putStrLn "Using AFM v4.1 metrics..." + ; loadAfmMetrics dir ["Times-Roman"] >>= makePictures + } + _ -> putStrLn default_font_loader_help -pic1 :: TreePicture -pic1 = drawTreePicture charNode (standardContext 18) (uniformScaling 30) tree1 +makePictures :: BaseGlyphMetrics -> IO () +makePictures base_metrics = do + -- + let pic1 = runDrawingU (makeCtx 18 base_metrics) tree_drawing1 + writeEPS "./out/tree01.eps" pic1 + writeSVG "./out/tree01.svg" pic1 + -- + let pic2 = runDrawingU (makeCtx 24 base_metrics) tree_drawing2 + writeEPS "./out/tree02.eps" pic2 + writeSVG "./out/tree02.svg" pic2 + -- + let pic3 = runDrawingU (makeCtx 14 base_metrics) tree_drawing3 + writeEPS "./out/tree03.eps" pic3 + writeSVG "./out/tree03.svg" pic3 + -- + let pic4 = runDrawingU (makeCtx 24 base_metrics) tree_drawing4 + writeEPS "./out/tree04.eps" pic4 + writeSVG "./out/tree04.svg" pic4 + -- + let pic5 = runDrawingU (makeCtx 24 base_metrics) tree_drawing5 + writeEPS "./out/tree05.eps" pic5 + writeSVG "./out/tree05.svg" pic5 -pic2 :: TreePicture -pic2 = drawTreePicture (diskNode red) (standardContext 24) (uniformScaling 30) tree2 +makeCtx :: FontSize -> BaseGlyphMetrics -> DrawingContext +makeCtx sz m = fontface times_roman $ metricsContext sz m + + +tree_drawing1 :: DTreeDrawing +tree_drawing1 = drawScaledTree charNode (uniformScaling 30) tree1 + +tree_drawing2 :: DTreeDrawing +tree_drawing2 = drawScaledTree (diskNode red) (uniformScaling 30) tree2 + -- This should be drawn in the /family tree/ style... -pic3 :: TreePicture -pic3 = drawFamilyTreePicture charNode (standardContext 14) (uniformScaling 30) tree3 +-- +tree_drawing3 :: DTreeDrawing +tree_drawing3 = drawScaledFamilyTree charNode (uniformScaling 30) tree3 -pic4 :: TreePicture -pic4 = drawTreePicture (circleNode black) - (standardContext 24) - (scaleFactors 20 30) - tree4 -pic5 :: TreePicture -pic5 = drawTreePicture (circleNode black) - (standardContext 24) - (scaleFactors 20 30) - tree5 + +tree_drawing4 :: DTreeDrawing +tree_drawing4 = drawScaledTree (circleNode black) (scaleFactors 20 30) tree4 + +tree_drawing5 :: DTreeDrawing +tree_drawing5 = drawScaledTree (circleNode black) (scaleFactors 20 30) tree5 tree1 :: Tree Char diff --git a/demo/FontLoaderUtils.hs b/demo/FontLoaderUtils.hs new file mode 100644 --- /dev/null +++ b/demo/FontLoaderUtils.hs @@ -0,0 +1,95 @@ +{-# 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 + diff --git a/src/Wumpus/Tree.hs b/src/Wumpus/Tree.hs --- a/src/Wumpus/Tree.hs +++ b/src/Wumpus/Tree.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS -Wall #-} -------------------------------------------------------------------------------- @@ -15,18 +17,16 @@ module Wumpus.Tree ( -- * The type of rendered trees - TreePicture + TreeDrawing + , DTreeDrawing -- re-export. , ScaleFactors , uniformScaling , scaleFactors - , drawTreePicture - , drawFamilyTreePicture + , drawScaledTree + , drawScaledFamilyTree - -- * Output to file - , writeEPS_TreePicture - , writeSVG_TreePicture -- * Drawing nodes , charNode @@ -46,19 +46,12 @@ import Wumpus.Core -- package: wumpus-core +import Data.VectorSpace -- package: vector-space + import Data.Tree hiding ( drawTree ) --- | Output a 'TreePicture', generating an EPS file. --- -writeEPS_TreePicture :: FilePath -> TreePicture -> IO () -writeEPS_TreePicture = writeEPS_latin1 --- | Output a 'TreePicture', generating a SVG file. --- -writeSVG_TreePicture :: FilePath -> TreePicture -> IO () -writeSVG_TreePicture = writeSVG_latin1 - -- | Customize the size of the printed tree. -- -- A tree is /designed/ with a height of 1 unit between @@ -70,18 +63,19 @@ -- In the horizontal, 1 unit is the smallest possible distance -- between child nodes. -- -type ScaleFactors = ScalingContext Double Int Double +type ScaleFactors u = ScalingContext u Int u +type instance DUnit (ScaleFactors u) = u -- | Build uniform x- and y-scaling factors, i.e. @ x == y @. -- -uniformScaling :: Double -> ScaleFactors +uniformScaling :: Num u => u -> ScaleFactors u uniformScaling u = ScalingContext (\x -> u * x) (\y -> u * fromIntegral y) -scaleFactors :: Double -> Double -> ScaleFactors +scaleFactors :: Num u => u -> u -> ScaleFactors u scaleFactors sx sy = ScalingContext (\x -> sx * x) (\y -> sy * fromIntegral y) @@ -102,24 +96,23 @@ -- @tree@ is the input tree to be rendered. -- -- -drawTreePicture :: (a -> TreeNode) - -> DrawingContext - -> ScaleFactors +drawScaledTree :: (Real u, Floating u, FromPtSize u, InnerSpace (Vec2 u)) + => (a -> TreeNode u) + -> ScaleFactors u -> Tree a - -> TreePicture -drawTreePicture drawF dctx sfactors tree = - liftToPictureU $ drawTree drawF dctx $ design sfactors tree + -> TreeDrawing u +drawScaledTree drawF scale_f tree = drawTree drawF $ design scale_f tree -drawFamilyTreePicture :: (a -> TreeNode) - -> DrawingContext - -> ScaleFactors - -> Tree a - -> TreePicture -drawFamilyTreePicture drawF dctx sfactors tree = - liftToPictureU $ drawFamilyTree drawF dctx $ design sfactors tree +drawScaledFamilyTree :: (Real u, Floating u, FromPtSize u, InnerSpace (Vec2 u)) + => (a -> TreeNode u) + -> ScaleFactors u + -> Tree a + -> TreeDrawing u +drawScaledFamilyTree drawF scale_f tree = + drawFamilyTree drawF $ design scale_f tree -------------------------------------------------------------------------------- -- Drawing functions @@ -128,7 +121,8 @@ -- -- Useful for rendering @ Data.Tree Char @. -- -charNode :: Char -> TreeNode +charNode :: (Real u, Floating u, FromPtSize u) + => Char -> TreeNode u charNode = dotChar @@ -141,7 +135,8 @@ -- Also, only a single line of text is printed - any text after -- the first newline character will be dropped. -- -textNode :: String -> TreeNode +textNode :: (Real u, Floating u, FromPtSize u) + => String -> TreeNode u textNode = dotText . uptoNewline where uptoNewline = takeWhile (/='\n') @@ -150,16 +145,18 @@ -- -- Suitable for printing the shape of a tree, ignoring the data. -- -circleNode :: RGBi -> (a -> TreeNode) -circleNode rgb = \_ pt -> localize (strokeColour rgb) (dotCircle pt) +circleNode :: (Floating u, FromPtSize u) + => RGBi -> (a -> TreeNode u) +circleNode rgb = \_ -> localize (strokeColour rgb) dotCircle -- | Tree nodes with a filled circle. -- -- Suitable for printing the shape of a tree, ignoring the data. -- -diskNode :: RGBi -> (a -> TreeNode) -diskNode rgb = \_ pt -> localize (fillColour rgb) (dotDisk pt) +diskNode :: (Floating u, FromPtSize u) + => RGBi -> (a -> TreeNode u) +diskNode rgb = \_ -> localize (fillColour rgb) dotDisk diff --git a/src/Wumpus/Tree/Base.hs b/src/Wumpus/Tree/Base.hs --- a/src/Wumpus/Tree/Base.hs +++ b/src/Wumpus/Tree/Base.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS -Wall #-} @@ -17,7 +18,8 @@ module Wumpus.Tree.Base ( - TreePicture + TreeDrawing + , DTreeDrawing , CoordTree , TreeNode @@ -27,19 +29,26 @@ import Wumpus.Core -- package: wumpus-core import Wumpus.Basic.Dots.AnchorDots -- package: wumpus-basic +import Wumpus.Basic.Graphic import Data.Tree -- | A rendered tree - alias for for @Picture Double@ in -- Wumpus-Core. -- -type TreePicture = Picture Double +type TreeDrawing u = Drawing u +type DTreeDrawing = TreeDrawing Double + -- | Tree annotated with positions. -- type CoordTree u a = Tree (Point2 u, a) +type instance DUnit (CoordTree u a) = u -type TreeNode = DotLocImage Double + +type TreeNode u = DotLocImage u + + diff --git a/src/Wumpus/Tree/Design.hs b/src/Wumpus/Tree/Design.hs --- a/src/Wumpus/Tree/Design.hs +++ b/src/Wumpus/Tree/Design.hs @@ -41,42 +41,44 @@ -- | XPos is an absolute position -- -type XPos = Double +type XPos u = u -type XTree a = Tree (XPos,a) +type XTree u a = Tree (XPos u, a) -- | Delta - difference in X-positions. -- -type Delta = Double +type Delta u = u -data Span = S !XPos !XPos +data Span u = S !(XPos u) !(XPos u) deriving (Eq,Ord,Show) -outsideMerge :: Span -> Span -> Span +outsideMerge :: Span u -> Span u -> Span u outsideMerge (S p _) (S _ q) = S p q -moveSpan :: Delta -> Span -> Span +moveSpan :: Num u => Delta u -> Span u -> Span u moveSpan d (S p q) = S (p+d) (q+d) -newtype Extent = Extent { span_list :: [Span] } +newtype Extent u = Extent { span_list :: [Span u] } deriving (Eq,Show) -extlink :: XPos -> Extent -> Extent +extlink :: XPos u -> Extent u -> Extent u extlink a (Extent as) = Extent (S a a:as) -- note is this just for left ... ? -midtop :: XPos -> Extent -> XPos +-- +midtop :: Fractional u => XPos u -> Extent u -> XPos u midtop r (Extent []) = r midtop _ (Extent (S p q:_)) = p + (0.5*(q-p)) -- merge \"moving right\"... -mergeMR :: Delta -> Extent -> Extent -> Extent +-- +mergeMR :: Num u => Delta u -> Extent u -> Extent u -> Extent u mergeMR dx (Extent xs) (Extent ys) = Extent $ step xs ys where step ps [] = ps @@ -85,7 +87,7 @@ -- dx is negative... -- -mergeML :: Delta -> Extent -> Extent -> Extent +mergeML :: Num u => Delta u -> Extent u -> Extent u -> Extent u mergeML dx (Extent xs) (Extent ys) = Extent $ step xs ys where step ps [] = map (moveSpan dx) ps @@ -94,23 +96,24 @@ -extentZero :: Extent +extentZero :: Extent u extentZero = Extent [] -extentOne :: XPos -> Extent +extentOne :: XPos u -> Extent u extentOne x = Extent [S x x] -- 'moveTree' is now recursive... -- -moveTree :: Delta -> XTree a -> XTree a +moveTree :: Num u => Delta u -> XTree u a -> XTree u a moveTree dx (Node (x,a) subtrees) = Node ((x+dx),a) subtrees' where subtrees' = map (moveTree dx) subtrees -fit :: Extent -> Extent -> Double +fit :: (Fractional u, Ord u) + => Extent u -> Extent u -> u fit a b = step (span_list a) (span_list b) 0.0 where step (S _ p:ps) (S q _:qs) acc = step ps qs (max acc (p - q + 1.0)) @@ -120,7 +123,8 @@ -- Fitting the children of a node... -fitleft :: [(XTree a,Extent)] -> ([XTree a], Extent) +fitleft :: (Fractional u, Ord u) + => [(XTree u a,Extent u)] -> ([XTree u a], Extent u) fitleft [] = ([],extentZero) fitleft ((l,ext):xs) = (l:ts,ext') -- left-most child unchanged where @@ -129,7 +133,8 @@ step aex (t,ex) = let dx = fit aex ex in (mergeMR dx aex ex, moveTree dx t) -fitright :: [(XTree a,Extent)] -> ([XTree a], Extent) +fitright :: (Fractional u, Ord u) + => [(XTree u a, Extent u)] -> ([XTree u a], Extent u) fitright = post . foldr fn Nothing where post = fromMaybe ([],extentZero) @@ -145,37 +150,40 @@ -- Note - this will tell how wide the tree is... -- though the last exten is not necessarily the widest. -designl :: forall a. Tree a -> (XTree a, Extent) +designl :: forall a u. (Fractional u, Ord u) + => Tree a -> (XTree u a, Extent u) designl (Node a []) = (Node (0.0,a) [], extentOne 0.0) designl (Node a kids) = (Node (xpos,a) kids', ext1) where - xs :: [(XTree a,Extent)] + xs :: [(XTree u a, Extent u)] xs = map designl kids - kids' :: [XTree a] - ext0, ext1 :: Extent + kids' :: [XTree u a] + ext0, ext1 :: Extent u (kids',ext0) = fitleft xs xpos = midtop 0.0 ext0 ext1 = xpos `extlink` ext0 -designr :: forall a. XPos -> Tree a -> (XTree a, Extent) +designr :: forall u a. (Fractional u, Ord u) + => XPos u -> Tree a -> (XTree u a, Extent u) designr r (Node a []) = (Node (r,a) [], extentOne r) designr r (Node a kids) = (Node (xpos,a) kids', ext1) where - xs :: [(XTree a,Extent)] + xs :: [(XTree u a, Extent u)] xs = map (designr r) kids - kids' :: [XTree a] - ext0, ext1 :: Extent + kids' :: [XTree u a] + ext0, ext1 :: Extent u (kids',ext0) = fitright xs xpos = midtop r ext0 ext1 = xpos `extlink` ext0 -design :: ScalingContext Double Int u -> Tree a -> CoordTree u a +design :: (Fractional u, Ord u) + => ScalingContext u Int u -> Tree a -> CoordTree u a design sctx t = runScaling sctx (label 0 t3) where (t1,ext) = designl t @@ -197,13 +205,13 @@ -- find height and width -- -stats :: Extent -> (Int,Span) +stats :: (Num u, Ord u) => Extent u -> (Int, Span u) stats (Extent []) = (0,S 0 0) stats (Extent (e:es)) = foldr fn (1,e) es where fn (S x0 x1) (h, S xmin xmax) = (h+1, S (min x0 xmin) (max x1 xmax)) -mean :: Double -> Double -> Double +mean :: Fractional u => u -> u -> u mean x y = (x+y) / 2.0 diff --git a/src/Wumpus/Tree/Draw.hs b/src/Wumpus/Tree/Draw.hs --- a/src/Wumpus/Tree/Draw.hs +++ b/src/Wumpus/Tree/Draw.hs @@ -26,7 +26,6 @@ import Wumpus.Core -- package: wumpus-core -import Wumpus.Basic.Anchors -- package: wumpus-basic import Wumpus.Basic.Dots.AnchorDots import Wumpus.Basic.Graphic @@ -40,29 +39,31 @@ --------------------------------------------------------------------------------- -- Draw individual connector between parent and each child node. -drawTree :: (a -> TreeNode) - -> DrawingContext - -> CoordTree Double a - -> HPrim Double -drawTree drawF ctx tree = execDrawing ctx $ drawTop drawF tree +drawTree :: (Real u, Floating u, FromPtSize u, InnerSpace (Vec2 u)) + => (a -> TreeNode u) + -> CoordTree u a + -> Drawing u +drawTree drawF tree = drawTracing $ drawTop drawF tree -drawTop :: (a -> TreeNode) -> CoordTree Double a -> Drawing Double () +drawTop :: (Real u, Floating u, InnerSpace (Vec2 u)) + => (a -> TreeNode u) -> CoordTree u a -> TraceDrawing u () drawTop fn (Node (pt,a) ns) = do ancr <- drawi $ fn a `at` pt mapM_ (draw1 fn ancr) ns -draw1 :: (a -> TreeNode) - -> DotAnchor Double - -> CoordTree Double a - -> Drawing Double () +draw1 :: (Real u, Floating u, InnerSpace (Vec2 u)) + => (a -> TreeNode u) + -> DotAnchor u + -> CoordTree u a + -> TraceDrawing u () draw1 fn ancr_from (Node (pt,a) ns) = do ancr <- drawi $ fn a `at` pt draw $ connector ancr_from ancr mapM_ (draw1 fn ancr) ns -connector :: (Floating u, Real u, InnerSpace (Vec2 u)) +connector :: (Real u, Floating u, InnerSpace (Vec2 u)) => DotAnchor u -> DotAnchor u -> Graphic u connector a1 a2 = openStroke $ vertexPath [p1,p2] where @@ -73,7 +74,7 @@ -anchorAngles :: (Floating u, Real u, InnerSpace (Vec2 u)) +anchorAngles :: (Floating u, Real u, InnerSpace (Vec2 u)) => Point2 u -> Point2 u -> (Radian,Radian) anchorAngles f t = (theta0, theta1) where @@ -85,16 +86,17 @@ -------------------------------------------------------------------------------- -- Draw in /family tree/ style -drawFamilyTree :: (a -> TreeNode) - -> DrawingContext - -> CoordTree Double a - -> HPrim Double -drawFamilyTree drawF ctx tree = execDrawing ctx $ drawFamily drawF tree +drawFamilyTree :: (Real u, Floating u, FromPtSize u) + => (a -> TreeNode u) + -> CoordTree u a + -> Drawing u +drawFamilyTree drawF tree = drawTracing $ drawFamily drawF tree -drawFamily :: (a -> TreeNode) - -> CoordTree Double a - -> Drawing Double (DotAnchor Double) +drawFamily :: (Fractional u, Ord u) + => (a -> TreeNode u) + -> CoordTree u a + -> TraceDrawing u (DotAnchor u) drawFamily fn (Node (pt,a) ns) = do ancr <- drawi $ fn a `at` pt xs <- mapM (drawFamily fn) ns @@ -107,9 +109,9 @@ famconn pt_from xs@(p1:_) = oconcat downtick (horizontal : upticks) where hh = halfHeight pt_from p1 - downtick = straightLine (vvec (-hh)) pt_from + downtick = straightLine (vvec (-hh)) `at` pt_from horizontal = midline (vdisplace (-hh) pt_from) xs - upticks = map (straightLine (vvec hh)) xs + upticks = map (straightLine (vvec hh) `at`) xs midline :: (Fractional u, Ord u) => Point2 u -> [Point2 u] -> Graphic u midline _ [] = error "midline - empty list" diff --git a/src/Wumpus/Tree/VersionNumber.hs b/src/Wumpus/Tree/VersionNumber.hs --- a/src/Wumpus/Tree/VersionNumber.hs +++ b/src/Wumpus/Tree/VersionNumber.hs @@ -22,7 +22,7 @@ -- | Version number -- --- > (0,10,0) +-- > (0,11,0) -- wumpus_tree_version :: (Int,Int,Int) -wumpus_tree_version = (0,10,0) +wumpus_tree_version = (0,11,0) diff --git a/wumpus-tree.cabal b/wumpus-tree.cabal --- a/wumpus-tree.cabal +++ b/wumpus-tree.cabal @@ -1,5 +1,5 @@ name: wumpus-tree -version: 0.10.0 +version: 0.11.0 license: BSD3 license-file: LICENSE copyright: Stephen Tetley @@ -15,10 +15,36 @@ output should be quite good - no overlapping edges, identical subtrees should have the same shape, leaf nodes evenly spaced. . + Note - the demos now use font metrics. Font metrics for the + \"Core 14\" PostScript fonts are distributed as @*.afm@ files + with GhostScript (AFM file version 2.0 for GhostScript 8.63) or + 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: + + . + Core 14 AFM metrics: + + . + . \*\* WARNING \*\* - the API is unstable and will change. . Changelog: . + 0.10.0 to 0.11.0: + . + * Changed types of drawing functions so they can be run with + glyph metrics (read from file in the IO monad). + . + * Generalized the unit type of the /design/ functions to some + numeric @u@ rather than Double. + . + * The demo has been duplicated - one version uses GhostScript + glyph metrics and the other Adobe glyph metrics, as the + metrics are in different formats and need different font + loaders from Wumpus-Basic. + . 0.9.0 to 0.10.0: . * Internal changes to track updates to Wumpus-Basic. @@ -40,15 +66,16 @@ extra-source-files: CHANGES, LICENSE, - demo/Demo01.hs + demo/Demo01.hs, + demo/FontLoaderUtils.hs library hs-source-dirs: src build-depends: base < 5, containers >= 0.3.0 && < 0.4.0, vector-space >= 0.6, - wumpus-core == 0.36.0, - wumpus-basic == 0.12.0 + wumpus-core == 0.40.0, + wumpus-basic == 0.13.0 exposed-modules: