-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Basic objects and system code built on Wumpus-Core. -- -- Kernel code for higher-level drawing built on Wumpus-Core. This -- package provides font loader code (currently limited to AFM font -- files) and a various drawing objects intended to be a -- higher-level basis to make vector drawings than the primitives (paths, -- text labels) provided by Wumpus-Core. -- -- ** WARNING ** - this package is alpha grade and it is strongly coupled -- to the package Wumpus-Drawing which is sub-alpha grade. The -- packages are split as it is expected they will have different -- development speeds - Wumpus-Basic needs polishing and -- refinement; Wumpus-Drawing simply needs a lot of work to move -- its components from proof-of-concept ideas to being readily -- usable. -- -- NOTE - the demos that were previously included are now in the package -- Wumpus-Drawing. -- -- Changelog: -- -- v0.23.0 to v0.24.0: -- -- -- -- v0.22.0 to v0.23.0: -- -- -- -- v0.21.0 to v0.22.0: -- -- -- -- v0.20.0 to v0.21.0: -- -- @package wumpus-basic @version 0.24.0 -- | Version number module Wumpus.Basic.VersionNumber -- | Version number -- --
--   (0,24,0)
--   
wumpus_basic_version :: (Int, Int, Int) -- | A "join list" datatype and operations. -- -- A join list is implemented a binary tree, so joining two lists -- (catenation, aka (++)) is a cheap operation. -- -- This constrasts with the regular list datatype which is a cons list: -- while consing on a regular list is by nature cheap, joining (++) is -- expensive. module Wumpus.Basic.Utils.JoinList data JoinList a data ViewL a EmptyL :: ViewL a (:<) :: a -> (JoinList a) -> ViewL a data ViewR a EmptyR :: ViewR a (:>) :: (JoinList a) -> a -> ViewR a -- | Build a join list from a regular list. -- -- This builds a tall skinny list. -- -- WARNING - throws an error on empty list. fromList :: [a] -> JoinList a fromListF :: (a -> b) -> [a] -> JoinList b -- | Convert a join list to a regular list. toList :: JoinList a -> [a] toListF :: (a -> b) -> JoinList a -> [b] toListM :: Monad m => (a -> m b) -> JoinList a -> m [b] zipWithIntoList :: (a -> b -> c) -> JoinList a -> [b] -> [c] -- | Create an empty join list. empty :: JoinList a -- | Create a singleton join list. one :: a -> JoinList a -- | Cons an element to the front of the join list. cons :: a -> JoinList a -> JoinList a -- | Snoc an element to the tail of the join list. snoc :: JoinList a -> a -> JoinList a join :: JoinList a -> JoinList a -> JoinList a -- | Extract the first element of a join list - i.e. the leftmost element -- of the left spine. An error is thrown if the list is empty. -- -- This function performs a traversal down the left spine, so unlike -- head on regular lists this function is not performed in -- constant time. -- -- This function throws a runtime error on the empty list. head :: JoinList a -> a takeL :: Int -> JoinList a -> JoinList a length :: JoinList a -> Int takeWhileL :: (a -> Bool) -> JoinList a -> JoinList a accumMapL :: (x -> st -> (y, st)) -> JoinList x -> st -> (JoinList y, st) null :: JoinList a -> Bool -- | Access the left end of a sequence. -- -- Unlike the corresponing operation on Data.Sequence this is not a cheap -- operation, the joinlist must be traversed down the left spine to find -- the leftmost node. -- -- Also the traversal may involve changing the shape of the underlying -- binary tree. viewl :: JoinList a -> ViewL a -- | Access the right end of a sequence. -- -- Unlike the corresponing operation on Data.Sequence this is not a cheap -- operation, the joinlist must be traversed down the left spine to find -- the leftmost node. -- -- Also the traversal may involve changing the shape of the underlying -- binary tree. viewr :: JoinList a -> ViewR a unViewL :: ViewL a -> JoinList a unViewR :: ViewR a -> JoinList a instance Eq a => Eq (JoinList a) instance Eq a => Eq (ViewL a) instance Show a => Show (ViewL a) instance Eq a => Eq (ViewR a) instance Show a => Show (ViewR a) instance Functor ViewR instance Functor ViewL instance Traversable JoinList instance Foldable JoinList instance Functor JoinList instance Monoid (JoinList a) instance Show a => Show (JoinList a) -- | Two continuation parser combinators. module Wumpus.Basic.Utils.ParserCombinators data Parser s r data Result s ans Fail :: String -> [s] -> Result s ans Okay :: ans -> [s] -> Result s ans type CharParser a = Parser Char a type CharResult a = Result Char a type ParseError = String runParser :: Parser s a -> [s] -> Result s a runParserEither :: Show s => Parser s a -> [s] -> Either ParseError a apply :: Functor f => f a -> (a -> b) -> f b failure :: Parser s a throwError :: String -> Parser s a () :: Parser s a -> String -> Parser s a -- | This one is from Chris Okasaki's "Even Higher-Order Functions for -- Parsing". lookahead :: Parser s a -> (a -> Parser s b) -> Parser s b -- | Peek tries the supplied parse, but does not consume input ** even when -- the parse succeeds **. peek :: Parser s a -> Parser s a eof :: Parser s () equals :: Eq s => s -> Parser s s satisfy :: (s -> Bool) -> Parser s s oneOf :: Eq s => [s] -> Parser s s noneOf :: Eq s => [s] -> Parser s s chainl1 :: MonadPlus m => m a -> m (a -> a -> a) -> m a chainr1 :: MonadPlus m => m a -> m (a -> a -> a) -> m a chainl :: MonadPlus m => m a -> m (a -> a -> a) -> a -> m a chainr :: MonadPlus m => m a -> m (a -> a -> a) -> a -> m a choice :: Alternative f => [f a] -> f a count :: Applicative f => Int -> f a -> f [a] between :: Applicative f => f open -> f close -> f a -> f a option :: Alternative f => a -> f a -> f a optionMaybe :: Alternative f => f a -> f (Maybe a) optionUnit :: Alternative f => f a -> f () skipOne :: Applicative f => f a -> f () skipMany :: Alternative f => f a -> f () skipMany1 :: Alternative f => f a -> f () -- | many1 an alias for Control.Applicative some. many1 :: Alternative f => f a -> f [a] sepBy :: Alternative f => f a -> f b -> f [a] sepBy1 :: Alternative f => f a -> f b -> f [a] sepEndBy :: Alternative f => f a -> f b -> f [a] sepEndBy1 :: Alternative f => f a -> f b -> f [a] manyTill :: Alternative f => f a -> f b -> f [a] manyTill1 :: Alternative f => f a -> f b -> f [a] char :: Char -> CharParser Char string :: String -> CharParser String anyChar :: CharParser Char upper :: CharParser Char lower :: CharParser Char letter :: CharParser Char alphaNum :: CharParser Char digit :: CharParser Char hexDigit :: CharParser Char octDigit :: CharParser Char newline :: CharParser Char tab :: CharParser Char space :: CharParser Char instance (Eq s, Eq ans) => Eq (Result s ans) instance (Ord s, Ord ans) => Ord (Result s ans) instance (Show s, Show ans) => Show (Result s ans) instance MonadPlus (Parser s) instance Monad (Parser s) instance Alternative (Parser s) instance Applicative (Parser s) instance Functor (Parser s) -- | Generally you should expect to import this module qualified and define -- versions to consume trailing white-space. -- --
--   lexDef   :: P.LexemeParser
--   lexDef   = P.commentLineLexemeParser "Comment" [' ', '\t']
--   
--   lexeme   :: CharParser a -> CharParser a
--   lexeme   = P.lexeme lexDef
--   
--   integer  :: CharParser Int
--   integer  = lexeme P.integer
--   
module Wumpus.Basic.Utils.TokenParsers -- | Opaque type representing a parser that consumes arbitrary space. -- -- Unlike Parsec's lexeme parser, this can be customized so that e.g. -- newlines are not consumed as white space. data LexemeParser -- | Build a lexeme parser that handles space. -- -- Space is zero or more elements matching the isSpace -- predicate from Data.Char. spaceLexemeParser :: LexemeParser -- | Build a lexeme parser that handles arbitrary space. -- -- space is parametric, for instance this can manufacture a lexeme -- parser that consumes space and tab chars but not newline. spaceCharLexemeParser :: [Char] -> LexemeParser -- | Build a lexeme parser that handles start-and-end delimited comments -- and arbitrary space. commentLexemeParser :: String -> (String, String) -> [Char] -> LexemeParser -- | Build a lexeme parser that handles line spanning comments an arbitrary -- space. commentLineLexemeParser :: String -> [Char] -> LexemeParser -- | Build a lexeme parser that handles start-and-end delimited comments, -- line comments and arbitrary space. commentMultiLexemeParser :: String -> String -> [Char] -> LexemeParser -- | Wrap a CharParser with a lexeme parser, the CharParser will consume -- trailing space according to the strategy of the LexemeParser. lexeme :: LexemeParser -> CharParser a -> CharParser a whiteSpace :: LexemeParser -> CharParser () octBase :: CharParser Int octHask :: CharParser Int hexBase :: CharParser Int natural :: CharParser Integer integer :: CharParser Integer double :: CharParser Double -- | Hughes list, ... module Wumpus.Basic.Utils.HList type H a = [a] -> [a] emptyH :: H a wrapH :: a -> H a consH :: a -> H a -> H a snocH :: H a -> a -> H a appendH :: H a -> H a -> H a unfoldrH :: (b -> Maybe (a, b)) -> b -> H a -- | velo consumes the list as per map, but builds it back as a Hughes list -- - so items can be dropped replaced, repeated, etc... veloH :: (a -> H b) -> [a] -> H b concatH :: [H a] -> H a toListH :: H a -> [a] prefixListH :: H a -> [a] -> [a] fromListH :: [a] -> H a -- | Graphic objects RectAddress and Orientation to model rectangular -- positioning. module Wumpus.Basic.Kernel.Objects.Orientation -- | Datatype enumerating the addressable positions of a rectangle that can -- be derived for a PosObject. -- -- The positions are the compass points, plus the geometric center, -- origin and the baseline positions: -- --
--   BLL - baseline-left
--   
-- --
--   BLC - baseline-center 
--   
-- --
--   BLR - baseline-right
--   
data RectAddress CENTER :: RectAddress ORIGIN :: RectAddress NN :: RectAddress SS :: RectAddress EE :: RectAddress WW :: RectAddress NE :: RectAddress NW :: RectAddress SE :: RectAddress SW :: RectAddress BLL :: RectAddress BLC :: RectAddress BLR :: RectAddress -- | Utility datatype representing orientation within a rectangular -- frame. RectPos is useful for graphics such as text where the -- start point is not necessarily at the center (or bottom left). -- --
--   x_minor is the horizontal distance from the left to the start point
--   
--   x_major is the horizontal distance from the start point to the right
--   
--   y_minor is the vertical distance from the bottom to the start point
--   
--   y_major is the vertical distance from the start point to the top
--   
-- -- Values should be not be negative! data Orientation u Orientation :: !u -> !u -> !u -> !u -> Orientation u or_x_minor :: Orientation u -> !u or_x_major :: Orientation u -> !u or_y_minor :: Orientation u -> !u or_y_major :: Orientation u -> !u -- | The vector from a origin ro a RectAddress. vtoRectAddress :: (Fractional u, Ord u) => Orientation u -> RectAddress -> Vec2 u vtoOrigin :: (Fractional u, Ord u) => RectAddress -> Orientation u -> Vec2 u -- | Calculate the bounding box formed by locating the Orientation -- at the supplied point. orientationBounds :: Num u => Orientation u -> Point2 u -> BoundingBox u -- | Height of the orientation. orientationWidth :: Num u => Orientation u -> u -- | Height of the orientation. orientationHeight :: Num u => Orientation u -> u -- | Rotate an Orientation about its origin (locus). rotateOrientation :: (Real u, Floating u, Ord u) => Radian -> Orientation u -> Orientation u extendOrientation :: Num u => u -> u -> u -> u -> Orientation u -> Orientation u extendOLeft :: Num u => u -> Orientation u -> Orientation u extendORight :: Num u => u -> Orientation u -> Orientation u extendODown :: Num u => u -> Orientation u -> Orientation u extendOUp :: Num u => u -> Orientation u -> Orientation u fillHEven :: (Fractional u, Ord u) => u -> Orientation u -> Orientation u fillXMinor :: (Num u, Ord u) => u -> Orientation u -> Orientation u fillXMajor :: (Num u, Ord u) => u -> Orientation u -> Orientation u fillVEven :: (Fractional u, Ord u) => u -> Orientation u -> Orientation u fillYMajor :: (Num u, Ord u) => u -> Orientation u -> Orientation u fillYMinor :: (Num u, Ord u) => u -> Orientation u -> Orientation u -- | Second Orientation is moved to the right of the first along the -- spine i.e the baseline. spineRight :: (Num u, Ord u) => Orientation u -> Orientation u -> Orientation u -- | Second Orientation is moved below the first along the spine -- i.e. the vertical point between the left minor and right major (not -- the same as the horizontal center). spineBelow :: (Num u, Ord u) => Orientation u -> Orientation u -> Orientation u -- | xmin and xmaj same as left. halignBottomO :: (Num u, Ord u) => Orientation u -> Orientation u -> Orientation u -- | xmin same as left. halignCenterO :: (Fractional u, Ord u) => Orientation u -> Orientation u -> Orientation u -- | xmin and ymaj same as left. halignTopO :: (Num u, Ord u) => Orientation u -> Orientation u -> Orientation u -- | Align second below - xmin and ymaj are same as left. valignLeftO :: (Fractional u, Ord u) => Orientation u -> Orientation u -> Orientation u -- | Align second below - ymaj same as left. valignCenterO :: (Fractional u, Ord u) => Orientation u -> Orientation u -> Orientation u -- | Align second below - xmaj and ymaj are same as left. valignRightO :: (Fractional u, Ord u) => Orientation u -> Orientation u -> Orientation u -- | Move second right. spinemoveH :: Num u => Orientation u -> Orientation u -> Vec2 u -- | Move second below. spinemoveV :: Num u => Orientation u -> Orientation u -> Vec2 u binmoveHBottom :: Num u => Orientation u -> Orientation u -> Vec2 u binmoveHCenter :: (Fractional u, Ord u) => Orientation u -> Orientation u -> Vec2 u binmoveHTop :: Num u => Orientation u -> Orientation u -> Vec2 u binmoveVLeft :: Num u => Orientation u -> Orientation u -> Vec2 u binmoveVCenter :: (Fractional u, Ord u) => Orientation u -> Orientation u -> Vec2 u binmoveVRight :: Num u => Orientation u -> Orientation u -> Vec2 u instance Enum RectAddress instance Eq RectAddress instance Ord RectAddress instance Show RectAddress instance Eq u => Eq (Orientation u) instance Ord u => Ord (Orientation u) instance Show u => Show (Orientation u) instance Eq HDist instance Ord HDist instance Show HDist instance Eq VDist instance Ord VDist instance Show VDist instance (Fractional u, Ord u) => Monoid (Orientation u) instance Functor Orientation -- | Anchor points on shapes, bounding boxes, etc. -- -- Anchors are addressable positions, an examplary use is taking anchors -- on node shapes to get the in-bound and out-bound points for connectors -- in a network (graph) diagram. -- -- ** WARNING ** - the API here probably needs some more thought. module Wumpus.Basic.Kernel.Objects.Anchors -- | Note an Anchor is just a Point2. type Anchor u = Point2 u -- | Center of an object. class CenterAnchor a center :: (CenterAnchor a, u ~ DUnit a) => a -> Anchor u -- | Apex of an object. class ApexAnchor a apex :: (ApexAnchor a, u ~ DUnit a) => a -> Anchor u -- | Cardinal (compass) positions on an object. -- -- Cardinal anchors should be at their equivalent radial position. -- However, some shapes may not be able to easily define radial positions -- or may be able to provide more efficient definitions for the cardinal -- anchors. Hence the redundancy seems justified. class CardinalAnchor a north :: (CardinalAnchor a, u ~ DUnit a) => a -> Anchor u south :: (CardinalAnchor a, u ~ DUnit a) => a -> Anchor u east :: (CardinalAnchor a, u ~ DUnit a) => a -> Anchor u west :: (CardinalAnchor a, u ~ DUnit a) => a -> Anchor u -- | Secondary group of cardinal (compass) positions on an object for the -- diagonal positions. -- -- It seems possible that for some objects defining the primary compass -- points (north, south,...) will be straight-forward whereas defining -- the secondary compass points may be problematic, hence the compass -- points are split into two classes. class CardinalAnchor2 a northeast :: (CardinalAnchor2 a, u ~ DUnit a) => a -> Anchor u southeast :: (CardinalAnchor2 a, u ~ DUnit a) => a -> Anchor u southwest :: (CardinalAnchor2 a, u ~ DUnit a) => a -> Anchor u northwest :: (CardinalAnchor2 a, u ~ DUnit a) => a -> Anchor u -- | Anchor on a border that can be addressed by an angle. -- -- The angle is counter-clockwise from the right-horizontal, i.e. 0 is -- east. class RadialAnchor a radialAnchor :: RadialAnchor a => Radian -> u ~ DUnit a => a -> Anchor u -- | Anchors at the top left and right corners of a shape. -- -- For some shapes (Rectangle) the TikZ convention appears to be have -- cardinals as the corner anchors, but this doesn't seem to be uniform. -- Wumpus will need to reconsider anchors at some point... class TopCornerAnchor a topLeftCorner :: (TopCornerAnchor a, u ~ DUnit a) => a -> Anchor u topRightCorner :: (TopCornerAnchor a, u ~ DUnit a) => a -> Anchor u -- | Anchors at the bottom left and right corners of a shape. class BottomCornerAnchor a bottomLeftCorner :: (BottomCornerAnchor a, u ~ DUnit a) => a -> Anchor u bottomRightCorner :: (BottomCornerAnchor a, u ~ DUnit a) => a -> Anchor u -- | Anchors in the center of a side. -- -- Sides are addressable by index. Following TikZ, side 1 is expected to -- be the top of the shape. If the shape has an apex instead of a side -- then side 1 is expected to be the first side left of the apex. -- -- Implementations are also expected to modulo the side number, rather -- than throw an out-of-bounds error. class SideMidpointAnchor a sideMidpoint :: SideMidpointAnchor a => Int -> u ~ DUnit a => a -> Anchor u -- | projectAnchor : extract_func * dist * object -> Point -- -- -- Derive a anchor by projecting a line from the center of an object -- through the intermediate anchor (produced by the extraction function). -- The final answer point is located along the projected line at the -- supplied distance dist. -- -- E.g. take the north of a rectangle and project it 10 units further on: -- --
--   projectAnchor north 10 my_rect
--   
-- -- If the distance is zero the answer with be whatever point the the -- extraction function produces. -- -- If the distance is negative the answer will be along the projection -- line, between the center and the intermediate anchor. -- -- If the distance is positive the anchor will be extend outwards from -- the intermediate anchor. projectAnchor :: (Real u, Floating u, CenterAnchor a, u ~ DUnit a) => (a -> Anchor u) -> u -> a -> Anchor u -- | radialConnectorPoints : object_a * object_b -> -- (Point_a, Point_b) -- -- Find the radial connectors points for objects a and -- b along the line joining their centers. radialConnectorPoints :: (Real u, Floating u, CenterAnchor a, RadialAnchor a, CenterAnchor b, RadialAnchor b, u ~ DUnit a, u ~ DUnit b) => a -> b -> (Point2 u, Point2 u) instance Fractional u => CardinalAnchor2 (BoundingBox u) instance Fractional u => CardinalAnchor (BoundingBox u) instance Fractional u => CenterAnchor (BoundingBox u) -- | Wrapped versions of the Primitive type from Wumpus-Core. -- -- This file is essentially internal to Wumpus-Basic. module Wumpus.Basic.Kernel.Base.WrappedPrimitive -- | A wrapped version of Primitive from Wumpus-Core that supports -- Monoid. -- -- Note that CatPrim provides a single-object that can be -- hyperlinked or whatever. -- -- It is different to HPrim which is intended as a list type with -- efficient concatenation to support building of multiple Primitives in -- a frame. -- -- This type is essentially internal to Wumpus-Basic. data CatPrim prim1 :: Primitive -> CatPrim -- | Map cpmap :: (Primitive -> Primitive) -> CatPrim -> CatPrim cpmove :: Vec2 Double -> CatPrim -> CatPrim -- | Collected primitives - this type is effectively an analogue to a -- Frame in Wumpus-Core. -- -- This type is essentially internal to Wumpus-Basic. data HPrim u -- | Extract the internal list of Primitive from a HPrim. -- -- The expectation is that this Primitive list will be rendered by -- Wumpus-Core as a frame. hprimToList :: HPrim u -> [Primitive] -- | Form a HPrim from a CatPrim. singleH :: CatPrim -> HPrim u instance Monoid (HPrim u) instance Translate CatPrim instance Scale CatPrim instance RotateAbout CatPrim instance Rotate CatPrim instance Monoid CatPrim -- | Data types representing font metrics. module Wumpus.Basic.Kernel.Base.FontSupport type FontName = String -- | A Unicode code-point. type CodePoint = Int -- | FontDef wraps FontFace from Wumpus-Core with file name -- information for the font loaders. data FontDef FontDef :: FontFace -> String -> String -> FontDef font_def_face :: FontDef -> FontFace gs_file_name :: FontDef -> String afm_file_name :: FontDef -> String -- | A family group of FontDefs (regular, bold, italic and bold-italic). -- -- It is convenient for some higher-level text objects in Wumpus -- (particularly Doc in Wumpus-Drawing) to treat a font and its -- standard weights as the same entity. This allows Doc API to -- provide a bold operation to simply change to the the bold -- weight of the current family, rather than use the primitive -- set_font operation to change to an explicitly named font. data FontFamily FontFamily :: FontDef -> Maybe FontDef -> Maybe FontDef -> Maybe FontDef -> FontFamily ff_regular :: FontFamily -> FontDef ff_bold :: FontFamily -> Maybe FontDef ff_italic :: FontFamily -> Maybe FontDef ff_bold_italic :: FontFamily -> Maybe FontDef -- | Extract the regular weight FontDef from a FontFamily. regularWeight :: FontFamily -> FontDef -- | Extract the bold weight FontDef from a FontFamily. -- -- Note - this falls back to the regular weight if the font family has no -- bold weight. To get the bold weight or Nothing if it is not -- present use the record selector ff_bold. boldWeight :: FontFamily -> FontDef -- | Extract the italic weight FontDef from a -- FontFamily. -- -- Note - this falls back to the regular weight if the font family has no -- italic weight. To get the italic weight or Nothing if it is -- not present use the record selector ff_italic. italicWeight :: FontFamily -> FontDef -- | Extract the bold-italic weight FontDef from a -- FontFamily. -- -- Note - this falls back to the regular weight if the font family has no -- bold-italic weight. To get the bold-italic weight or Nothing -- if it is not present use the record selector ff_bold_italic. boldItalicWeight :: FontFamily -> FontDef -- | A lookup function from code point to width vector. -- -- The unit is always stored as a Double representing PostScript points. -- -- Note - in PostScript terminology a width vector is not obliged to be -- left-to-right (writing direction 0). It could be top-to-bottom -- (writing direction 1). type CharWidthLookup = CodePoint -> Vec2 Double -- | FontMetrics store a subset of the properties available in a -- font file - enough to calculate accurate bounding boxes and positions -- for text. -- --
--   Bounding box representing the maximum glyph area.
--   Width vectors for each character.
--   Cap height
--   Descender depth.
--   
-- -- Because Wumpus always needs font metrics respective to the current -- point size, the actual fields are all functions. data FontMetrics FontMetrics :: (FontSize -> BoundingBox Double) -> (FontSize -> CharWidthLookup) -> (FontSize -> Double) -> (FontSize -> Double) -> (FontSize -> Double) -> (FontSize -> Double) -> FontMetrics get_bounding_box :: FontMetrics -> FontSize -> BoundingBox Double get_cw_table :: FontMetrics -> FontSize -> CharWidthLookup get_cap_height :: FontMetrics -> FontSize -> Double get_descender :: FontMetrics -> FontSize -> Double get_underline_position :: FontMetrics -> FontSize -> Double get_underline_thickness :: FontMetrics -> FontSize -> Double -- | A map between a font name and the respective FontMetrics. data FontTable emptyFontTable :: FontTable -- | lookupFont : name * font_table -> Maybe FontMetrics -- -- -- Lookup a font in the font_table. lookupFont :: FontName -> FontTable -> Maybe FontMetrics -- | insertFont : name * font_metrics * font_table -> -- FontTable -- -- Insert a named font into the font_table. insertFont :: FontName -> FontMetrics -> FontTable -> FontTable -- | FontLoadMsg - type synonym for String. type FontLoadMsg = String -- | FontLoadLog is a Hughes list of Strings, so it supports -- efficient append. data FontLoadLog fontLoadMsg :: String -> FontLoadLog data FontLoadResult FontLoadResult :: FontTable -> FontLoadLog -> FontLoadResult loaded_font_table :: FontLoadResult -> FontTable loader_errors :: FontLoadResult -> FontLoadLog -- | Print the loader errors from the FontLoadResult to std-out. printLoadErrors :: FontLoadResult -> IO () -- | This ignores the Char code lookup and just returns the default advance -- vector. monospace_metrics :: FontMetrics instance Eq FontDef instance Ord FontDef instance Show FontDef instance Monoid FontLoadLog instance Monoid FontTable -- | Datatypes module Wumpus.Basic.System.FontLoader.Datatypes -- | 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 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 :: Maybe String -> Maybe AfmBoundingBox -> Maybe AfmUnit -> Maybe AfmUnit -> Maybe AfmUnit -> Maybe AfmUnit -> [AfmGlyphMetrics] -> AfmFile afm_encoding :: AfmFile -> Maybe String afm_letter_bbox :: AfmFile -> Maybe AfmBoundingBox afm_cap_height :: AfmFile -> Maybe AfmUnit afm_descender :: AfmFile -> Maybe AfmUnit afm_underline_position :: AfmFile -> Maybe AfmUnit afm_underline_thickness :: AfmFile -> Maybe AfmUnit afm_glyph_metrics :: AfmFile -> [AfmGlyphMetrics] data AfmGlyphMetrics AfmGlyphMetrics :: !PSCharCode -> !Vec2 AfmUnit -> !String -> AfmGlyphMetrics afm_char_code :: AfmGlyphMetrics -> !PSCharCode afm_width_vector :: AfmGlyphMetrics -> !Vec2 AfmUnit afm_char_name :: AfmGlyphMetrics -> !String -- | Monospace defaults are used if the font loader fails to extract the -- necessary fields. -- -- The values are taken from the font correpsonding to Courier in the -- distributed font files. data MonospaceDefaults cu MonospaceDefaults :: BoundingBox cu -> cu -> cu -> cu -> cu -> Vec2 cu -> MonospaceDefaults cu default_letter_bbox :: MonospaceDefaults cu -> BoundingBox cu default_cap_height :: MonospaceDefaults cu -> cu default_descender :: MonospaceDefaults cu -> cu default_underline_position :: MonospaceDefaults cu -> cu default_underline_thickness :: MonospaceDefaults cu -> cu default_char_width :: MonospaceDefaults cu -> Vec2 cu -- | The metrics read from a font file by a font loader. -- -- NOTE - FontProps is parametric on cu - Character Unit -- and not on the usual u. A typical character unit is -- AfmUnit, the unit of measurement for AFM files (1000th of a -- point). -- -- The is the initial representation used by Wumpus-Basic as an syntax -- tree when loading font files. data FontProps cu FontProps :: BoundingBox cu -> Vec2 cu -> IntMap (Vec2 cu) -> cu -> cu -> cu -> cu -> FontProps cu fp_bounding_box :: FontProps cu -> BoundingBox cu fp_default_adv_vec :: FontProps cu -> Vec2 cu fp_adv_vecs :: FontProps cu -> IntMap (Vec2 cu) fp_cap_height :: FontProps cu -> cu fp_descender :: FontProps cu -> cu fp_underline_position :: FontProps cu -> cu fp_underline_thickness :: FontProps cu -> cu -- | Build a MetricsOps function table, from a character unit scaling -- function and FontProps read from a file. buildMetricsOps :: (FontSize -> cu -> Double) -> FontProps cu -> FontMetrics instance Eq AfmGlyphMetrics instance Show AfmGlyphMetrics instance Show AfmFile instance (Ord cu, Tolerance cu) => Eq (MonospaceDefaults cu) instance Show cu => Show (MonospaceDefaults cu) -- | Common parsers for AFM files. module Wumpus.Basic.System.FontLoader.AfmParserBase afmFileParser :: CharParser AfmGlyphMetrics -> CharParser AfmFile runQuery :: String -> CharParser a -> GlobalInfo -> Maybe a textQuery :: String -> GlobalInfo -> Maybe String -- | Strictly speaking a fontBBox is measured in integer units. getFontBBox :: GlobalInfo -> Maybe AfmBoundingBox getEncodingScheme :: GlobalInfo -> Maybe String getCapHeight :: GlobalInfo -> Maybe AfmUnit charBBox :: CharParser AfmBoundingBox metric :: String -> a -> CharParser a -> CharParser a keyStringPair :: CharParser (AfmKey, String) versionNumber :: CharParser String startCharMetrics :: CharParser Int keyName :: CharParser AfmKey newlineOrEOF :: CharParser () name :: CharParser String name1 :: CharParser String semi :: CharParser Char uptoNewline :: CharParser String number :: CharParser AfmUnit cint :: CharParser Int hexInt :: CharParser Int octInt :: CharParser Int lexeme :: CharParser a -> CharParser a symbol :: String -> CharParser String integer :: CharParser Integer int :: CharParser Int double :: CharParser Double -- | 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.System.FontLoader.AfmV4Dot1Parser afmV4Dot1Parser :: CharParser AfmFile -- | 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.System.FontLoader.AfmV2Parser afmV2Parser :: CharParser AfmFile -- | The elementary base types and classes. module Wumpus.Basic.Kernel.Base.BaseDefs quarter_pi :: Radian half_pi :: Radian two_pi :: Radian ang180 :: Radian ang150 :: Radian ang120 :: Radian ang90 :: Radian ang60 :: Radian ang45 :: Radian ang30 :: Radian ang15 :: Radian -- | The empty data type - i.e. () - wrapped with a phantom unit -- parameter. data UNil u UNil :: UNil u -- | Return a UNil rather than () at the end of sequence of -- monadic commands. -- -- Many Wumpus objects are usefully constructed in the -- do-notation, but because Wumpus has to expose the type of the -- unit to the type checker we must finish the do-block with: -- --
--   ureturn
--   
-- -- or: -- --
--   return UNil
--   
-- -- rather than: -- --
--   return ()
--   
ureturn :: Monad m => m (UNil u) -- | uvoid runs a monadic computation and returns UNil. uvoid :: Monad m => m a -> m (UNil u) class ScalarUnit a fromPsPoint :: ScalarUnit a => Double -> a toPsPoint :: ScalarUnit a => a -> Double class (Eq u, Num u) => InterpretUnit u normalize :: InterpretUnit u => FontSize -> u -> Double dinterp :: InterpretUnit u => FontSize -> Double -> u -- | dinterp an object that gives access to its unit at the functor -- position. dinterpF :: (Functor t, InterpretUnit u) => FontSize -> t Double -> t u -- | normalize an object that gives access to its unit at the -- functor position. normalizeF :: (Functor t, InterpretUnit u) => FontSize -> t u -> t Double -- | Convert a scalar value from one unit to another. uconvert1 :: (InterpretUnit u, InterpretUnit u1) => FontSize -> u -> u1 -- | Unit convert an object that gives access to its unit at the Functor -- position. -- -- In practive this will be *all* Image answers. uconvertF :: (Functor t, InterpretUnit u, InterpretUnit u1) => FontSize -> t u -> t u1 intraMapPoint :: InterpretUnit u => FontSize -> (DPoint2 -> DPoint2) -> Point2 u -> Point2 u intraMapFunctor :: (Functor f, InterpretUnit u) => FontSize -> (f Double -> f Double) -> f u -> f u -- | Unit parametric version of KerningChar from Wumpus-Core. type KernChar u = (u, EscapedChar) -- | Draw closed paths. -- --
--   OSTROKE - open and stroked
--   
-- --
--   CSTROKE - closed and stroke
--   
-- --
--   CFILL - closed and filled
--   
-- --
--   CFILL_STROKE - closed, the path is filled, its edge is stroked.
--   
data PathMode OSTROKE :: PathMode CSTROKE :: PathMode CFILL :: PathMode CFILL_STROKE :: PathMode -- | Draw closed paths and shapes. -- --
--   DRAW_STROKE - closed and stroked
--   
-- --
--   DRAW_FILL - closed and filled
--   
-- --
--   DRAW_FILL_STROKE - the path is filled, its edge is stroked.
--   
data DrawMode DRAW_STROKE :: DrawMode DRAW_FILL :: DrawMode DRAW_FILL_STROKE :: DrawMode -- | Interpret a DrawMode for a closed path. closedMode :: DrawMode -> PathMode -- | Enumerated type for drawing with respect to the z-order. data ZOrder ZBELOW :: ZOrder ZABOVE :: ZOrder -- | Horizontal alignment - align to the top, center or bottom. data HAlign HALIGN_TOP :: HAlign HALIGN_CENTER :: HAlign HALIGN_BASE :: HAlign -- | Vertical alignment - align to the left, center or bottom. data VAlign VALIGN_LEFT :: VAlign VALIGN_CENTER :: VAlign VALIGN_RIGHT :: VAlign -- | Wumpus distinguishes two use-cases for displaying vertically centered -- text. -- -- Arbitrary text that is expected to contain lower case letters with -- descenders, show take the vertical center as the mid-point between the -- cap height and the descender depth. -- -- Unfortunately, including the descender depth can produce unbalanced -- results for text which is not expected to have descenders (e.g. -- numbers within a bordered box), visually this makes the center too -- high. data TextHeight JUST_CAP_HEIGHT :: TextHeight CAP_HEIGHT_PLUS_DESCENDER :: TextHeight -- | An enumeratied type representing the compass positions. data Cardinal NORTH :: Cardinal NORTH_EAST :: Cardinal EAST :: Cardinal SOUTH_EAST :: Cardinal SOUTH :: Cardinal SOUTH_WEST :: Cardinal WEST :: Cardinal NORTH_WEST :: Cardinal -- | An enumerated type representing horizontal and vertical directions. data Direction UP :: Direction DOWN :: Direction LEFT :: Direction RIGHT :: Direction -- | An enumerated type representing clock directions. data ClockDirection CW :: ClockDirection CCW :: ClockDirection -- | Note - behaviour at the continuity (0 deg, 180 deg, ...) is -- unspecified. clockDirection :: (Real u, Floating u) => Vec2 u -> Vec2 u -> ClockDirection -- | An enumerated type representing horizontal direction. data HDirection LEFTWARDS :: HDirection RIGHTWARDS :: HDirection horizontalDirection :: Radian -> HDirection -- | An enumerated type representing vertical direction. data VDirection UPWARDS :: VDirection DOWNWARDS :: VDirection verticalDirection :: Radian -> VDirection -- | An enumerated type representing quadrants. data Quadrant QUAD_NE :: Quadrant QUAD_NW :: Quadrant QUAD_SW :: Quadrant QUAD_SE :: Quadrant -- | quadrant : ang -> Quadrant -- -- Get the quadrant of an angle. quadrant :: Radian -> Quadrant -- | bezierArcPoints : apex_angle * radius * inclination * -- center -> [Point] -- --
--   ang should be in the range 0 < ang < 360deg.
--   
-- --
--   if   0 < ang <=  90 returns 4 points
--   if  90 < ang <= 180 returns 7 points
--   if 180 < ang <= 270 returns 10 points
--   if 270 < ang <  360 returns 13 points
--   
bezierArcPoints :: Floating u => Radian -> u -> Radian -> Point2 u -> [Point2 u] -- | bezierMinorArc : apex_angle * radius * rotation * center -- -> BezierCurve -- --
--   ang should be in the range 0 < ang <= 90deg.
--   
bezierMinorArc :: Floating u => Radian -> u -> Radian -> Point2 u -> (Point2 u, Point2 u, Point2 u, Point2 u) -- | Applicative both - run both computations return the pair of the -- the answers. both :: Applicative f => f a -> f b -> f (a, b) -- | Monodial scheme - prefix, repeat body n times, suffix. monPreRepeatPost :: Monoid a => a -> (Int, a) -> a -> a instance Eq (UNil u) instance Ord (UNil u) instance Read (UNil u) instance Show (UNil u) instance Bounded PathMode instance Enum PathMode instance Eq PathMode instance Ord PathMode instance Show PathMode instance Bounded DrawMode instance Enum DrawMode instance Eq DrawMode instance Ord DrawMode instance Show DrawMode instance Bounded ZOrder instance Enum ZOrder instance Eq ZOrder instance Ord ZOrder instance Show ZOrder instance Enum HAlign instance Eq HAlign instance Ord HAlign instance Show HAlign instance Enum VAlign instance Eq VAlign instance Ord VAlign instance Show VAlign instance Enum TextHeight instance Eq TextHeight instance Ord TextHeight instance Show TextHeight instance Enum Cardinal instance Eq Cardinal instance Ord Cardinal instance Show Cardinal instance Enum Direction instance Eq Direction instance Ord Direction instance Show Direction instance Enum HDirection instance Eq HDirection instance Ord HDirection instance Show HDirection instance Enum VDirection instance Eq VDirection instance Ord VDirection instance Show VDirection instance Enum ClockDirection instance Eq ClockDirection instance Ord ClockDirection instance Show ClockDirection instance Enum Quadrant instance Eq Quadrant instance Ord Quadrant instance Show Quadrant instance InterpretUnit AfmUnit instance InterpretUnit Double instance ScalarUnit Double instance Translate (UNil u) instance Scale (UNil u) instance RotateAbout (UNil u) instance Rotate (UNil u) instance Monoid (UNil u) instance Functor UNil -- | Units cm, pica and "contextual" units - em, -- en. module Wumpus.Basic.Kernel.Base.Units -- | Wrapped Double representing Centimeter. data Centimeter -- | Cast a value in Centimeters to some Fractional type. -- -- Note - this casting should only be used for non-contextual units such -- as Double. cm :: Fractional u => Centimeter -> u -- | Convert Double to Centimer. dcm :: Double -> Centimeter -- | Wrapped Double Pica unit type. -- -- Pica is 12 Points. data Pica -- | Cast a value in Pica to some Fractional type. -- -- Note - this casting should only be used for non-contextual units such -- as Double. pica :: Fractional u => Pica -> u -- | Convert a Double to a Pica. dpica :: Double -> Pica -- | Wrapped Double representing an Em. data Em -- | Wrapped Double representing an En. data En instance Eq Centimeter instance Ord Centimeter instance Num Centimeter instance Floating Centimeter instance Fractional Centimeter instance Real Centimeter instance RealFrac Centimeter instance RealFloat Centimeter instance Eq Pica instance Ord Pica instance Num Pica instance Floating Pica instance Fractional Pica instance Real Pica instance RealFrac Pica instance RealFloat Pica instance Eq Em instance Ord Em instance Num Em instance Floating Em instance Fractional Em instance Real Em instance RealFrac Em instance RealFloat Em instance Eq En instance Ord En instance Num En instance Floating En instance Fractional En instance Real En instance RealFrac En instance RealFloat En instance Tolerance En instance InterpretUnit En instance Show En instance Tolerance Em instance InterpretUnit Em instance Show Em instance Tolerance Pica instance InterpretUnit Pica instance ScalarUnit Pica instance Show Pica instance Tolerance Centimeter instance InterpretUnit Centimeter instance ScalarUnit Centimeter instance Show Centimeter -- | Drawing attributes -- -- ** WARNING ** - The drawing context modules need systematic naming -- schemes both for update functions (primaryColour, ...) and for -- synthesized selectors (e.g. lowerxHeight). The current names in -- QueryDC and UpdateDC are expected to change. module Wumpus.Basic.Kernel.Base.DrawingContext -- | DrawingContext - the "graphics state" of Wumpus-Basic. -- DrawingContext is operated on within a Reader monad rather than a -- State monad so "updates" are delineated within a local -- operation (called localize in Wumpus), rather than permanent -- until overridden as per set of a State monad. -- -- Note - in contrast to most other drawing objects in Wumpus, none of -- the types of measurement values are parameteric (usually notated with -- the type variable u in Wumpus). Types are either -- Double representing PostScript points or Em - a contextual size -- that is interpreted according to the current font size. -- -- It is easier to specialize all the measurement types and within the -- DrawingContext and add parametricity to the getters and -- setters instead. data DrawingContext DrawingContext :: FontTable -> FontLoadLog -> FontMetrics -> FontFace -> !FontSize -> (Double, Double) -> StrokeAttr -> RGBi -> RGBi -> RGBi -> Double -> TextMargin -> DrawingContext dc_font_metrics_table :: DrawingContext -> FontTable dc_font_load_log :: DrawingContext -> FontLoadLog dc_fallback_metrics :: DrawingContext -> FontMetrics dc_font_face :: DrawingContext -> FontFace dc_font_size :: DrawingContext -> !FontSize dc_snap_grid_factors :: DrawingContext -> (Double, Double) dc_stroke_props :: DrawingContext -> StrokeAttr dc_stroke_colour :: DrawingContext -> RGBi dc_fill_colour :: DrawingContext -> RGBi dc_text_colour :: DrawingContext -> RGBi dc_line_spacing_factor :: DrawingContext -> Double dc_text_margin :: DrawingContext -> TextMargin -- | Type synonym for DrawingContext update functions. type DrawingContextF = DrawingContext -> DrawingContext -- | The text margin is measured in Em so it is relative to the -- current font size. -- -- The default value is 0.5. data TextMargin TextMargin :: !Em -> !Em -> TextMargin text_margin_x :: TextMargin -> !Em text_margin_y :: TextMargin -> !Em -- | standardContext : font_size -> DrawingContext -- -- Create a DrawingContext. -- -- Note - font_size is used for sizing more than just text -- labels. Arrowheads, plot marks and other elements have their metrics -- derived from the font size. -- -- No real font metrics are present in the DrawingContext created -- by standardContext. Static, hard-coded fallback metrics derived -- from the Courier font are available but these metrics might -- not accurately correspond to the Courier available to the the -- final renderer (GhostScript, an SVG viewer, etc.). -- -- Use this constructor for drawings that make primitive use of text. -- --
--   font_metrics_table:  empty
--   font_load_log:       empty
--   fallback_metrics:    monospace_metrics
--   font_face:           Courier
--   font_size:           @supplied_font_size@
--   stroke_props:        line_width 1, no dash_pattern, cap-butt, join-miter. 
--   stroke_colour:       black
--   fill_colour:         light_gray
--   text_colour:         black
--   line_spacing_factor: 0.2
--   round_corner_factor: 0
--   text_margin:         (0.5 em, 0.5 em) 
--   
standardContext :: FontSize -> DrawingContext -- | metricsContext : font_size * font_metrics -> -- DrawingContext -- -- Create a DrawingContext with font metrics loaded from the file -- system. -- -- Note - font_size is used for sizing more than just text -- labels. Arrowheads, plot marks and other elements have their metrics -- derived from the font size. -- -- Use this constructor for drawings that make use of the text objects -- provided by Wumpus-Drawing (DocText and RotText). metricsContext :: FontSize -> FontLoadResult -> DrawingContext -- | addFontTables : font_load_result -> DrawinContextUpdate -- -- -- Add the font metrics from the FontLoadResult, if a font with the same -- name alreay exists in the DrawingContext it will be replaced. -- Error and warning messages in the font_load_result will be -- appended to the font_load_log. addFontTables :: FontLoadResult -> DrawingContextF -- | reset_drawing_properties : DrawingContextF -- -- Reset the drawing properties in the DrawingContext to their -- default values. This changes the following fields: -- --
--   stroke_props:        line_width 1, no dash_pattern, cap-butt, join-miter. 
--   stroke_colour:       black
--   fill_colour:         light_gray
--   text_colour:         black
--   line_spacing_factor: 0.2
--   round_corner_factor: 0
--   text_margin:         (0.5 em, 0.5 em) 
--   
reset_drawing_properties :: DrawingContextF -- | reset_drawing_metrics : DrawingContextF -- -- Reset the drawing metrics in the DrawingContext to their -- default values. This is a more limited version of -- reset_drawing_properties and changes the following fields: -- --
--   stroke_props:        line_width 1, no dash_pattern, cap-butt, join-miter. 
--   line_spacing_factor: 0.2
--   round_corner_factor: 0
--   text_margin:         (0.5 em, 0.5 em) 
--   
reset_drawing_metrics :: DrawingContextF -- | DrawingCtxM is equivalent to the to the MonadReader -- class, but the environment type is fixed to DrawingContext. -- -- To avoid name clashes with mtl this scheme is used: -- --
--   askDC    = ask
--   asksDC   = asks
--   localize = local
--   
-- -- Note, because the derived operation query (aka asks) -- is expected to be used more often than queryCtx (aka ask) it -- gets the more convenient name. class (Applicative m, Monad m) => DrawingCtxM (m :: * -> *) where asksDC f = f <$> askDC askDC :: DrawingCtxM m => m DrawingContext asksDC :: DrawingCtxM m => (DrawingContext -> a) -> m a localize :: DrawingCtxM m => (DrawingContext -> DrawingContext) -> m a -> m a withFontMetrics :: (FontMetrics -> FontSize -> u) -> DrawingContext -> u -- | Querying the Drawing Context. -- -- ** WARNING ** - parts of this module especially the mono-space glyph -- metrics need a re-think and will change or be dropped. module Wumpus.Basic.Kernel.Base.QueryDC normalizeCtx :: (DrawingCtxM m, InterpretUnit u) => u -> m Double normalizeCtxF :: (DrawingCtxM m, Functor t, InterpretUnit u) => t u -> m (t Double) dinterpCtx :: (DrawingCtxM m, InterpretUnit u) => Double -> m u dinterpCtxF :: (DrawingCtxM m, Functor t, InterpretUnit u) => t Double -> m (t u) uconvertCtx1 :: (DrawingCtxM m, InterpretUnit u, InterpretUnit u1) => u -> m u1 uconvertCtxF :: (DrawingCtxM m, Functor t, InterpretUnit u, InterpretUnit u1) => t u -> m (t u1) pointSize :: DrawingCtxM m => m FontSize strokeAttr :: DrawingCtxM m => m (RGBi, StrokeAttr) fillAttr :: DrawingCtxM m => m RGBi borderedAttr :: DrawingCtxM m => m (RGBi, StrokeAttr, RGBi) textAttr :: DrawingCtxM m => m (RGBi, FontAttr) -- | Get the Point corresponding the grid coordinates scaled by the -- snap-grid scaling factors. position :: (DrawingCtxM m, Fractional u) => (Int, Int) -> m (Point2 u) -- | Scale a vector coordinate by the snap-grid scaling factors. -- -- Absolute units. snapmove :: (DrawingCtxM m, Fractional u) => (Int, Int) -> m (Vec2 u) -- | Get the (x,y) margin around text. -- -- Note - not all text operations in Wumpus are drawn with text margin. textMargin :: (DrawingCtxM m, InterpretUnit u) => m (u, u) getLineWidth :: DrawingCtxM m => m Double getFontAttr :: DrawingCtxM m => m FontAttr getFontSize :: DrawingCtxM m => m Int getFontFace :: DrawingCtxM m => m FontFace getTextColour :: DrawingCtxM m => m RGBi -- | Vertical distance between descender of a line and the cap-height of -- the line below. textlineSpace :: (DrawingCtxM m, Fractional u, InterpretUnit u) => m u -- | Get the font bounding box - this is the maximum boundary of the glyphs -- in the font. The span of the height is expected to be bigger than the -- cap_height plus descender depth. glyphBoundingBox :: (DrawingCtxM m, InterpretUnit u) => m (BoundingBox u) -- | Height of a capital letter. capHeight :: (DrawingCtxM m, InterpretUnit u) => m u -- | Note - descender is expected to be negative. descender :: (DrawingCtxM m, InterpretUnit u) => m u -- | Note - underline_position is expected to be negative. underlinePosition :: (DrawingCtxM m, InterpretUnit u) => m u -- | Line width of underline line. underlineThickness :: (DrawingCtxM m, InterpretUnit u) => m u -- | This is the distance from cap_height to descender. verticalSpan :: (DrawingCtxM m, InterpretUnit u) => m u -- | Variant of verticalSpan that accounts for the specified -- TextHeight. -- -- This returns a pair of (yminor, ymajor). heightSpan :: (DrawingCtxM m, InterpretUnit u) => TextHeight -> m (u, u) -- | Find the advance vector for the supplied EscapedText. -- -- Note - the text assumed to be a single line. escTextVector :: (DrawingCtxM m, InterpretUnit u) => EscapedText -> m (Vec2 u) -- | Find the advance vector for the supplied EscapedChar. escCharVector :: (DrawingCtxM m, InterpretUnit u) => EscapedChar -> m (Vec2 u) -- | hkernVector : [kerning_char] -> AdvanceVec -- -- hkernvector takes whatever length is paired with the -- EscapedChar for the init of the the list, for the last element it -- takes the charVector. hkernVector :: (DrawingCtxM m, InterpretUnit u) => [KernChar u] -> m (Vec2 u) -- | Note the CharWidthLookup is not parameteric on units. -- -- CharWidth is always Double representing PostScript points. -- Client code must convert this value accordingly. cwLookupTable :: DrawingCtxM m => m CharWidthLookup -- | Customize drawing attributes. The functions here are -- DrawingContext modifiers to be run within a the scope of a -- localize block (cf. local of the Reader monad). -- -- By convention, underscore-separated names are used for DrawingContext -- modifiers in this module. This is because the modifiers defined here -- are expected to be used mostly as static "properties" resembling -- constants in drawings. module Wumpus.Basic.Kernel.Base.UpdateDC -- | snap_grid_factors : x_unit * y_unit -> DrawingContextF -- -- -- Set the snap grid factors - a snap grid is an alternative -- coordinate space, it can be convenient for drawing "box and arrow" -- diagrams. snap_grid_factors :: Double -> Double -> DrawingContextF -- | set_line_width : width_in_points -> DrawingContextF -- -- Set the line_width to the supplied point size. -- -- Initially the line width is 1.0. -- -- Constant variations of the function maybe be more convenient: -- --
--   line_default, line_thin, line_thick, line_ultra_thick
--   
set_line_width :: Double -> DrawingContextF -- | Set the line_width to default - 1.0. line_default :: DrawingContextF -- | Set the line_width to thin - 0.5. line_thin :: DrawingContextF -- | Set the line_width to thick - 2.0. line_thick :: DrawingContextF -- | Set the line_width to ultra_thick - 4.0. line_ultra_thick :: DrawingContextF -- | Set the line width to a size relative to the current font size. The -- size is calculated with the supplied function. contextual_line_width :: (FontSize -> Double) -> DrawingContextF -- | Scale the line width respective to its current value. -- -- The size is calculated with the supplied function. relative_line_width :: (Double -> Double) -> DrawingContextF -- | Set the line_cap to the default which is butt. -- -- This is a synonym for cap_butt. cap_default :: DrawingContextF -- | Set the line_cap to butt. -- -- Butt chamfers off the stroke, flush to the end point. -- -- This is the default. -- --
--   .-------.
--   |=======|
--   '-------'
--   
cap_butt :: DrawingContextF -- | Set the line_cap to round. -- -- This rounds the end of the stroke and the visually the rounding -- slightly extends the length of the line. -- --
--    .-------.
--   ( ======= )
--    '-------'
--   
cap_round :: DrawingContextF -- | Set the line_cap to square. -- -- This squares off the end of the stroke, but visual extends the stroke -- by half the line width. -- --
--   .---------.
--   | ======= |
--   '---------'
--   
cap_square :: DrawingContextF -- | Set the line_join to the default which is miter. -- -- This is a synonym for join_miter. join_default :: DrawingContextF -- | Set the line_join to miter. -- -- This extends the joining line segments to form a sharp miter. -- -- This is the default. -- --
--       /\
--      /..\ 
--     /./\.\
--    /./  \.\
--   /./    \.\
--   
join_miter :: DrawingContextF -- | Set the line_join to round. -- -- This rounds off the corner of the joined line segments. -- --
--   \.\  
--    \.\ 
--     ,.)
--    /./
--   /./
--   
join_round :: DrawingContextF -- | Set the line_join to round. -- -- This bevels off the corner of the joined line segments with a notch. -- --
--       __
--      /..\ 
--     /./\.\
--    /./  \.\
--   /./    \.\
--   
join_bevel :: DrawingContextF -- | Set the dash pattern. -- -- Initially the dash pattern is Solid. set_dash_pattern :: DashPattern -> DrawingContextF -- | Set the dash_pattern to solid - i.e. no dash pattern. -- -- This is the default. solid_line :: DrawingContextF -- | Set the dash pattern to draw a dotted line. -- -- A dot is actually a square - side length is equal to the line width. -- -- The spacing between dots is 2 times the dot width. dotted_line :: DrawingContextF -- | Set the dash pattern to draw a tightly packed dotted line. -- -- A dot is actually a square - side length is equal to the line width. -- -- The spacing between dots is equal to the dot width. packed_dotted :: DrawingContextF -- | Set the dash pattern to draw a loosely dotted line. -- -- A dot is actually a square - side length is equal to the line width. -- -- The spacing between dots is 4 times the dot width. loose_dotted :: DrawingContextF -- | Set the dash pattern to draw a dashed line. -- -- The dash length is 3 times the line width, the spacing is 2 times the -- line width. dashed_line :: DrawingContextF -- | Set the dash pattern to draw a tightly packed, dashed line. -- -- The dash length is 3 times the line width, the spacing is equal to the -- line width. packed_dashed :: DrawingContextF -- | Set the dash pattern to draw a loosely dashed line. -- -- The dash length is 3 times the line width, the spacing is 4 times the -- line width. loose_dashed :: DrawingContextF -- | Set the font attributes, point size and font face. font_attr :: FontDef -> Int -> DrawingContextF -- | Set the font face. set_font :: FontDef -> DrawingContextF -- | Set the point size. -- -- This controls the drawing size of both text labels and marks (e.g. -- dots and arrowheads). set_font_size :: Int -> DrawingContextF -- | Scale the current point size by the supplied ratio. -- -- Note - as fonts can only be drawn at integral sizes this operation is -- not exact - for instance scaling 15pt by (1%2) results in 7pt. scale_point_size :: Double -> DrawingContextF -- | Set the point size (font and mark size) to double the current size. double_point_size :: DrawingContextF -- | Set the point size to half the current size, note the point size also -- controls the size of dots, arrowsheads etc. -- -- Note - as fonts can only be drawn at integral sizes this operation is -- not exact - half size of 15pt type is 7pt. half_point_size :: DrawingContextF -- | text_margin : x_sep * y_sep -> DrawingContextF -- -- Note - this is in Em units. text_margin :: Em -> Em -> DrawingContextF -- | Set the text margin to (0,0). -- -- This produces a tight box around the text vertically measured to the -- cap-height and descender. Therefore some characters may extend outside -- the margin (e.g. accented capitals like A-grave). text_margin_none :: DrawingContextF -- | Set the text margin to (0.25 em, 0.25 em). text_margin_tight :: DrawingContextF -- | Set the text margin to (0.5 em, 0.5 em). text_margin_default :: DrawingContextF -- | Set the text margin to (1.0 em, 1.0 em). text_margin_loose :: DrawingContextF -- | Set the stroke colour. stroke_colour :: RGBi -> DrawingContextF -- | Set the fill colour. fill_colour :: RGBi -> DrawingContextF -- | Set the text colour. text_colour :: RGBi -> DrawingContextF -- | Set the stroke, fill and text colours to a single colour. single_colour :: RGBi -> DrawingContextF -- | Swap the stroke colour and fill colours. swap_colours :: DrawingContextF -- | Set the fill colour to use the current stroke colour. fill_use_stroke_colour :: DrawingContextF -- | Set the stroke colour to use the current fill colour. stroke_use_fill_colour :: DrawingContextF -- | Set the fill colour to use the current text colour. fill_use_text_colour :: DrawingContextF -- | Set the stroke colour to use the current fill colour. stroke_use_text_colour :: DrawingContextF -- | Set the text colour to use the current stroke colour. text_use_stroke_colour :: DrawingContextF -- | Set the text colour to use the current fill colour. text_use_fill_colour :: DrawingContextF -- | Common types and operations. module Wumpus.Basic.Kernel.Objects.Basis type PrimResult u a = (a, CatPrim) class UConvert (f :: * -> * -> *) uconvF :: (UConvert f, Functor t, InterpretUnit u, InterpretUnit u1) => f u (t u) -> f u1 (t u1) uconvZ :: (UConvert f, InterpretUnit u, InterpretUnit u1) => f u a -> f u1 a -- | Note - the kind of f allows fo unit annotation. ignoreAns :: Functor (f u) => f u a -> f u (UNil u) -- | Replace the answer produced by a graphic object. replaceAns :: Functor (f u) => a -> f u z -> f u a -- | Decorate an object -- -- oliterate - drops the graphic from the first object replacing it with -- the graphic from the second. class Decorate (f :: * -> * -> *) decorate :: Decorate f => ZOrder -> f u a -> f u z -> f u a elaborate :: Decorate f => ZOrder -> f u a -> (a -> f u z) -> f u a obliterate :: Decorate f => f u a -> f u a hyperlink :: Decorate f => XLink -> f u a -> f u a svgId :: Decorate f => String -> f u a -> f u a svgAnnotate :: Decorate f => [SvgAttr] -> f u a -> f u a -- | Decorate (ABOVE) a with b. decorateAbove :: Decorate f => f u a -> f u z -> f u a -- | Decorate (BELOW) a with b. decorateBelow :: Decorate f => f u a -> f u z -> f u a -- | Elaborate (ABOVE) a with b. elaborateAbove :: Decorate f => f u a -> (a -> f u z) -> f u a -- | Elaborate (BELOW) a with b. elaborateBelow :: Decorate f => f u a -> (a -> f u z) -> f u a -- | Classes for concatenation. module Wumpus.Basic.Kernel.Objects.Concat -- | Minimal defintion is superior, anterior is usually -- flip superior. -- --
--   `superior` (infixr 6)
--   
-- --
--   `anterior` (infixr 6)
--   
class ZConcat o where anterior = flip superior anterior :: ZConcat o => o -> o -> o superior :: ZConcat o => o -> o -> o cat :: (Monoid o, ZConcat o) => [o] -> o -- | Concatenation with movement - the second object is moved next -- to the first. -- --
--   hconcat is equivalent to @(<>)@ in WL-PPrint.
--   (infixr 6)
--   
-- --
--   vconcat is equivalent to @(<$>)@ in WL_PPrint.
--   (infixr 5)
--   
class Concat o hconcat :: Concat o => o -> o -> o vconcat :: Concat o => o -> o -> o -- | Horizontally concatenate a list of objects. -- -- Note - the first argument is an alternative - this is drawn if -- the list is empty, otherwise it is not drawn. hcat :: (Monoid o, Concat o) => [o] -> o -- | Vertically concatenate a list of objects. -- -- Note - the first argument is an alternative - this is drawn if -- the list is empty, otherwise it is not drawn. vcat :: (Monoid o, Concat o) => [o] -> o class CatSpace o hspace :: (CatSpace o, u ~ DUnit o) => u -> o -> o -> o vspace :: (CatSpace o, u ~ DUnit o) => u -> o -> o -> o hsep :: (Monoid o, CatSpace o, u ~ DUnit o) => u -> [o] -> o vsep :: (Monoid o, CatSpace o, u ~ DUnit o) => u -> [o] -> o class Align o halign :: Align o => HAlign -> o -> o -> o valign :: Align o => VAlign -> o -> o -> o alignRow :: (Monoid o, Align o) => HAlign -> [o] -> o alignColumn :: (Monoid o, Align o) => VAlign -> [o] -> o class AlignSpace o halignSpace :: (AlignSpace o, u ~ DUnit o) => HAlign -> u -> o -> o -> o valignSpace :: (AlignSpace o, u ~ DUnit o) => VAlign -> u -> o -> o -> o alignRowSep :: (Monoid o, AlignSpace o, u ~ DUnit o) => HAlign -> u -> [o] -> o alignColumnSep :: (Monoid o, AlignSpace o, u ~ DUnit o) => VAlign -> u -> [o] -> o -- | Displacing points - often start points. module Wumpus.Basic.Kernel.Objects.Displacement -- | PointDisplace is a type representing functions from Point -- to Point. -- -- It is especially useful for building composite graphics where one part -- of the graphic is drawn from a different start point to the other -- part. type PointDisplace u = Point2 u -> Point2 u -- | ThetaPointDisplace is a type representing functions from -- Radian * Point to Point. -- -- It is useful for building arrowheads which are constructed with an -- implicit angle representing the direction of the line at the arrow -- tip. type ThetaPointDisplace u = Radian -> Point2 u -> Point2 u -- | displace : Vec2 -> PointDisplace -- -- Alias for .+^ from Data.AffineSpace. displace :: Num u => Vec2 u -> PointDisplace u -- | dispParallel : dist -> ThetaPointDisplace -- -- Build a combinator to move Points in parallel to the -- direction of the implicit angle by the supplied distance -- dist. dispParallel :: Floating u => u -> ThetaPointDisplace u -- | dispParallel : dist -> ThetaPointDisplace -- -- Build a combinator to move Points perpendicular to the -- inclnation of the implicit angle by the supplied distance -- dist. dispPerpendicular :: Floating u => u -> ThetaPointDisplace u -- | dispOrtho : vec -> ThetaPointDisplace -- -- This is a combination of displaceParallel and -- displacePerpendicular, with the x component of the vector -- displaced in parallel and the y component displaced perpendicular. dispOrtho :: Floating u => u -> u -> ThetaPointDisplace u -- | Angular version of dispDirection. -- -- The displacement direction is with respect to implicit angle of -- inclination, so: -- --
--   up    == perpendicular
--   down  == perdendicular . negate
--   left  == parallel . negate
--   right == parallel
--   
dispDirectionTheta :: Floating u => Direction -> u -> ThetaPointDisplace u -- | Angular version of dispCardinal. -- -- The displacement direction is with respect to implicit angle of -- inclination, so: -- --
--   north == perpendicular
--   east  == parallel
--   south == perdendicular . negate
--   etc.
--   
dispCardinalTheta :: Floating u => Cardinal -> u -> ThetaPointDisplace u go_up :: Num u => u -> Vec2 u go_down :: Num u => u -> Vec2 u go_left :: Num u => u -> Vec2 u go_right :: Num u => u -> Vec2 u go_north :: Num u => u -> Vec2 u go_south :: Num u => u -> Vec2 u go_east :: Num u => u -> Vec2 u go_west :: Num u => u -> Vec2 u go_north_east :: Floating u => u -> Vec2 u go_north_west :: Floating u => u -> Vec2 u go_south_east :: Floating u => u -> Vec2 u go_south_west :: Floating u => u -> Vec2 u go_up_left :: Num u => u -> Vec2 u go_up_right :: Num u => u -> Vec2 u go_down_left :: Num u => u -> Vec2 u go_down_right :: Num u => u -> Vec2 u theta_up :: Floating u => u -> Radian -> Vec2 u theta_down :: Floating u => u -> Radian -> Vec2 u -- | Parallel (reverse) theta_left :: Floating u => u -> Radian -> Vec2 u -- | Parallel (forward) theta_right :: Floating u => u -> Radian -> Vec2 u theta_north :: Floating u => u -> Radian -> Vec2 u theta_south :: Floating u => u -> Radian -> Vec2 u theta_east :: Floating u => u -> Radian -> Vec2 u theta_west :: Floating u => u -> Radian -> Vec2 u theta_north_east :: Floating u => u -> Radian -> Vec2 u theta_north_west :: Floating u => u -> Radian -> Vec2 u theta_south_east :: Floating u => u -> Radian -> Vec2 u theta_south_west :: Floating u => u -> Radian -> Vec2 u theta_up_left :: Floating u => u -> Radian -> Vec2 u theta_up_right :: Floating u => u -> Radian -> Vec2 u theta_down_left :: Floating u => u -> Radian -> Vec2 u theta_down_right :: Floating u => u -> Radian -> Vec2 u -- | Return a-o when supplied length of b-o and the -- grazing angle boa: -- --
--     a
--     .\
--     . \
--   ..b..o
--   
-- -- This is useful for building arrowhead vectors. theta_adj_grazing :: Floating u => u -> Radian -> Radian -> Vec2 u -- | Return o-c when supplied length of b-o and the -- grazing angle boc: -- --
--   ..b..o
--     . /
--     ./
--     c
--   
-- -- This is useful for building arrowhead vectors. theta_bkwd_adj_grazing :: Floating u => u -> Radian -> Radian -> Vec2 u -- | Common types and operations. module Wumpus.Basic.Kernel.Objects.Image data Image u a type Graphic u = Image u (UNil u) data Query u a -- | Type specialized version of Image. type DImage a = Image Double a -- | Type specialized version of Graphic. type DGraphic = Graphic Double runImage :: DrawingContext -> Image u a -> PrimResult u a runQuery :: DrawingContext -> Query u a -> a -- | Strip the graphic content from an Image making a Query. stripImage :: Image u a -> Query u a -- | Turn a Query into an Image without graphic content. liftQuery :: Query u a -> Image u a -- | Having empty at the specific Image type is useful. emptyImage :: Monoid a => Image u a -- | Constructor for Primtive graphics. primGraphic :: CatPrim -> Graphic u -- | Clip an Image. clipImage :: PrimPath -> Image u a -> Image u a instance (Translate a, InterpretUnit u, u ~ DUnit a) => Translate (Image u a) instance Scale a => Scale (Image u a) instance (RotateAbout a, InterpretUnit u, u ~ DUnit a) => RotateAbout (Image u a) instance Rotate a => Rotate (Image u a) instance Decorate Image instance UConvert Image instance DrawingCtxM (Query u) instance DrawingCtxM (Image u) instance Monoid a => Monoid (Query u a) instance Monoid a => Monoid (Image u a) instance Monad (Query u) instance Monad (Image u) instance Applicative (Query u) instance Applicative (Image u) instance Functor (Query u) instance Functor (Image u) -- | ConnImage and ConnGraphic types - these are functional types from the -- DrawingContext plus start point and end point to a graphic -- primitive. module Wumpus.Basic.Kernel.Objects.Connector -- | ConnectorImage - function from DrawingContext and start and end points -- to a polymorphic answer and a graphic primitive. data ConnectorImage u a type ConnectorGraphic u = ConnectorImage u (UNil u) -- | Type specialized version of ConnectorImage. type DConnectorImage a = ConnectorImage Double a -- | Type specialized version of ConnectorGraphic. type DConnectorGraphic = ConnectorGraphic Double data ConnectorQuery u a runConnectorImage :: InterpretUnit u => DrawingContext -> Point2 u -> Point2 u -> ConnectorImage u a -> PrimResult u a runConnectorQuery :: InterpretUnit u => DrawingContext -> Point2 u -> Point2 u -> ConnectorQuery u a -> a connect :: InterpretUnit u => ConnectorImage u a -> Point2 u -> Point2 u -> Image u a stripConnectorImage :: ConnectorImage u a -> ConnectorQuery u a liftConnectorQuery :: ConnectorQuery u a -> ConnectorImage u a promoteConn :: InterpretUnit u => (Point2 u -> Point2 u -> Image u a) -> ConnectorImage u a applyConn :: InterpretUnit u => ConnectorImage u a -> Point2 u -> Point2 u -> Image u a qpromoteConn :: InterpretUnit u => (Point2 u -> Point2 u -> Query u a) -> ConnectorQuery u a qapplyConn :: InterpretUnit u => ConnectorQuery u a -> Point2 u -> Point2 u -> Query u a -- | Having empty at the specific ConnectorImage type is -- useful. emptyConnectorImage :: Monoid a => ConnectorImage u a instance UConvert ConnectorImage instance Decorate ConnectorImage instance DrawingCtxM (ConnectorQuery u) instance DrawingCtxM (ConnectorImage u) instance Monoid a => Monoid (ConnectorQuery u a) instance Monoid a => Monoid (ConnectorImage u a) instance Monad (ConnectorQuery u) instance Monad (ConnectorImage u) instance Applicative (ConnectorQuery u) instance Applicative (ConnectorImage u) instance Functor (ConnectorQuery u) instance Functor (ConnectorImage u) -- | LocImage and LocGraphic types - these are functional types from the -- DrawingContext and start point to a graphic primitive. module Wumpus.Basic.Kernel.Objects.LocImage -- | LocThetaImage - function from start point and DrawingContext -- to a polymorphic answer and a graphic primitive (PrimW). data LocImage u a type LocGraphic u = LocImage u (UNil u) -- | Type specialized version of LocImage. type DLocImage a = LocImage Double a -- | Type specialized version of LocGraphic. type DLocGraphic = LocGraphic Double data LocQuery u a runLocImage :: InterpretUnit u => DrawingContext -> Point2 u -> LocImage u a -> PrimResult u a runLocQuery :: InterpretUnit u => DrawingContext -> Point2 u -> LocQuery u a -> a stripLocImage :: LocImage u a -> LocQuery u a liftLocQuery :: LocQuery u a -> LocImage u a promoteLoc :: InterpretUnit u => (Point2 u -> Image u a) -> LocImage u a applyLoc :: InterpretUnit u => LocImage u a -> Point2 u -> Image u a -- | Flipped version of applyLoc. supplyLoc :: InterpretUnit u => Point2 u -> LocImage u a -> Image u a qpromoteLoc :: InterpretUnit u => (Point2 u -> Query u a) -> LocQuery u a qapplyLoc :: InterpretUnit u => LocQuery u a -> Point2 u -> Query u a -- | Having empty at the specific LocImage type is useful. emptyLocImage :: Monoid a => LocImage u a moveStart :: InterpretUnit u => Vec2 u -> LocImage u a -> LocImage u a -- | Downcast a LocImage function by applying it to the supplied -- point, making an Image. -- --
--   infixr 1 `at`
--   
at :: InterpretUnit u => LocImage u a -> Point2 u -> Image u a distrib :: (Monoid a, InterpretUnit u) => Vec2 u -> [LocImage u a] -> LocImage u a distribH :: (Monoid a, InterpretUnit u) => u -> [LocImage u a] -> LocImage u a distribV :: (Monoid a, InterpretUnit u) => u -> [LocImage u a] -> LocImage u a -- | This is analogue to replicate in the Prelude. duplicate :: (Monoid a, InterpretUnit u) => Int -> Vec2 u -> LocImage u a -> LocImage u a duplicateH :: (Monoid a, InterpretUnit u) => Int -> u -> LocImage u a -> LocImage u a duplicateV :: (Monoid a, InterpretUnit u) => Int -> u -> LocImage u a -> LocImage u a instance UConvert LocImage instance (InterpretUnit u, Translate a, ScalarUnit u, u ~ DUnit a) => Translate (LocImage u a) instance (Fractional u, InterpretUnit u, Scale a) => Scale (LocImage u a) instance (Real u, Floating u, InterpretUnit u, RotateAbout a, u ~ DUnit a) => RotateAbout (LocImage u a) instance (Real u, Floating u, InterpretUnit u, Rotate a) => Rotate (LocImage u a) instance Decorate LocImage instance DrawingCtxM (LocQuery u) instance DrawingCtxM (LocImage u) instance Monoid a => Monoid (LocQuery u a) instance Monoid a => Monoid (LocImage u a) instance Monad (LocQuery u) instance Monad (LocImage u) instance Applicative (LocQuery u) instance Applicative (LocImage u) instance Functor (LocQuery u) instance Functor (LocImage u) -- | User state class for Drawing monads. module Wumpus.Basic.Kernel.Drawing.Basis class (Applicative m, Monad m) => UserStateM (m :: * -> *) getState :: (UserStateM m, st ~ UState (m a)) => m st setState :: (UserStateM m, st ~ UState (m a)) => st -> m () updateState :: (UserStateM m, st ~ UState (m a)) => (st -> st) -> m () -- | Monad that collects a graphic trace, insertl is analogue to the -- Writer monad's tell. class InsertlM (m :: * -> *) where insertl_ = insertl . ignoreAns insertl :: (InsertlM m, u ~ DUnit (m ())) => LocImage u a -> m a insertl_ :: (InsertlM m, u ~ DUnit (m ())) => LocImage u a -> m (UNil u) -- | Monad with notion of location - i.e. the current point. class Monad m => LocationM (m :: * -> *) location :: (LocationM m, u ~ DUnit (m ())) => m (Point2 u) -- | Monad with turtle-like cursor movememnt. class LocationM m => CursorM (m :: * -> *) moveby :: (CursorM m, u ~ DUnit (m ())) => Vec2 u -> m () -- | Add operations for branching at the current point. -- -- Not all drawings that support tracing support branching. For instance -- Paths can be built by tracing but they always need a cumulative -- progression of next point they cannot resrt to the start point -- and go in a differnt direction. class CursorM m => BranchCursorM (m :: * -> *) branchCursor :: BranchCursorM m => m a -> m a -- | Move the cursor horizontally. hmoveby :: (CursorM m, Num u, u ~ DUnit (m ())) => u -> m () -- | Move the cursor vertically. vmoveby :: (CursorM m, Num u, u ~ DUnit (m ())) => u -> m () -- | Drawing monad with immutable start point. module Wumpus.Basic.Kernel.Drawing.LocDrawing -- | GenLocDrawing is a reader-writer-state monad, unlike -- GenLocTrace there is no updateable current point, instead the -- start point is supplied when the drawing is run and it is translated -- by the components of the start point. -- -- The writer accumulates a graphical trace. -- -- Essentially, GenLocDrawing is an Image object extended -- with user state. data GenLocDrawing st u a type LocDrawing u a = GenLocDrawing () u a class Monad m => LocDrawM (m :: * -> *) where inserti_ gf = inserti gf >> return () insertli_ pt gf = insertli pt gf >> return () insertci_ p1 p2 gf = insertci p1 p2 gf >> return () inserti :: (LocDrawM m, u ~ DUnit (m ())) => Image u a -> m a inserti_ :: (LocDrawM m, u ~ DUnit (m ())) => Image u a -> m () insertli :: (LocDrawM m, u ~ DUnit (m ())) => Anchor u -> LocImage u a -> m a insertli_ :: (LocDrawM m, u ~ DUnit (m ())) => Anchor u -> LocImage u a -> m () insertci :: (LocDrawM m, u ~ DUnit (m ())) => Anchor u -> Anchor u -> ConnectorImage u a -> m a insertci_ :: (LocDrawM m, u ~ DUnit (m ())) => Anchor u -> Anchor u -> ConnectorImage u a -> m () runGenLocDrawing :: (Translate a, InterpretUnit u, u ~ DUnit a) => st -> GenLocDrawing st u a -> LocImage u (a, st) -- | Forget the user state LocImage, just return the answer. evalGenLocDrawing :: (Translate a, InterpretUnit u, u ~ DUnit a) => st -> GenLocDrawing st u a -> LocImage u a -- | Forget the answer, just return the user state. execGenLocDrawing :: (Translate a, InterpretUnit u, u ~ DUnit a) => st -> GenLocDrawing st u a -> LocImage u st stripGenLocDrawing :: (Translate a, InterpretUnit u, u ~ DUnit a) => st -> GenLocDrawing st u a -> LocQuery u (a, st) -- | Simple version of runGenLocDrawing - run a LocDrawing -- without user state. runLocDrawing :: (Translate a, InterpretUnit u, u ~ DUnit a) => LocDrawing u a -> LocImage u a runLocDrawing_ :: (Translate a, InterpretUnit u, u ~ DUnit a) => LocDrawing u a -> LocGraphic u instance InterpretUnit u => LocDrawM (GenLocDrawing st u) instance Monoid a => Monoid (GenLocDrawing st u a) instance UserStateM (GenLocDrawing st u) instance DrawingCtxM (GenLocDrawing st u) instance Monad (GenLocDrawing st u) instance Applicative (GenLocDrawing st u) instance Functor (GenLocDrawing st u) -- | Writer monad with imperative turtle style movement to build -- LocGraphics. module Wumpus.Basic.Kernel.Drawing.LocTrace -- | GenLocTrace is a reader-writer-state monad. -- -- The writer accumulates a graphical trace and the state is the current -- point. data GenLocTrace st u a type LocTrace u a = GenLocTrace () u a runGenLocTrace :: InterpretUnit u => st -> GenLocTrace st u a -> LocImage u (a, st) -- | Forget the user state LocImage, just return the answer. evalGenLocTrace :: InterpretUnit u => st -> GenLocTrace st u a -> LocImage u a -- | Forget the answer, just return the user state. execGenLocTrace :: InterpretUnit u => st -> GenLocTrace st u a -> LocImage u st stripGenLocTrace :: InterpretUnit u => st -> GenLocTrace st u a -> LocQuery u (a, st) -- | Simple version of runGenLocTrace - run a LocTrace -- without user state. runLocTrace :: InterpretUnit u => LocTrace u a -> LocImage u a runLocTrace_ :: InterpretUnit u => LocTrace u a -> LocGraphic u instance InterpretUnit u => BranchCursorM (GenLocTrace st u) instance InterpretUnit u => CursorM (GenLocTrace st u) instance InterpretUnit u => InsertlM (GenLocTrace st u) instance InterpretUnit u => LocationM (GenLocTrace st u) instance Monoid a => Monoid (GenLocTrace st u a) instance UserStateM (GenLocTrace st u) instance DrawingCtxM (GenLocTrace st u) instance Monad (GenLocTrace st u) instance Applicative (GenLocTrace st u) instance Functor (GenLocTrace st u) -- | Drawing with trace - a Writer like monad collecting -- intermediate graphics - and drawing context - a reader monad of -- attributes - font_face, fill_colour etc. module Wumpus.Basic.Kernel.Drawing.TraceDrawing data GenTraceDrawing st u a type TraceDrawing u a = GenTraceDrawing () u a type DTraceDrawing a = TraceDrawing Double a runTraceDrawing :: DrawingContext -> TraceDrawing u a -> (a, HPrim u) -- | Run the drawing returning only the output it produces, drop any answer -- from the monadic computation. execTraceDrawing :: DrawingContext -> TraceDrawing u a -> HPrim u -- | Run the drawing ignoring the output it produces, return the answer -- from the monadic computation. -- -- Note - this useful for testing, generally one would want the opposite -- behaviour (return the drawing, ignore than the answer). evalTraceDrawing :: DrawingContext -> TraceDrawing u a -> a runGenTraceDrawing :: DrawingContext -> st -> GenTraceDrawing st u a -> (a, st, HPrim u) -- | Unsafe promotion of HPrim to Picture. -- -- If the HPrim is empty, a run-time error is thrown. liftToPictureU :: HPrim u -> Picture -- | Safe promotion of HPrim to (Maybe Picture). -- -- If the HPrim is empty, then Nothing is returned. liftToPictureMb :: HPrim u -> Maybe Picture -- | Unsafe promotion of (Maybe Picture) to -- Picture. -- -- This is equivalent to: -- --
--   fromMaybe (error "empty") $ pic
--   
-- -- This function is solely a convenience, using it saves one import and a -- few characters. -- -- If the supplied value is Nothing a run-time error is thrown. mbPictureU :: Maybe Picture -> Picture -- | Primitive operation - cf. tell in Reader monad. trace :: HPrim u -> GenTraceDrawing st u () fontDelta :: GenTraceDrawing st u a -> GenTraceDrawing st u a evalQuery :: DrawingCtxM m => Query u a -> m a -- | Draw a Graphic taking the drawing style from the drawing -- context. -- -- This function is the forgetful version of drawi. -- Commonly, it is used to draw Graphic objects which have no -- answer. draw :: Image u a -> GenTraceDrawing st u () -- | Draw an Image taking the drawing style from the drawing -- context. -- -- The graphic representation of the Image is drawn in the Trace monad, -- and the result is returned. drawi :: Image u a -> GenTraceDrawing st u a -- | Draw a LocImage at the supplied Anchor taking the drawing style from -- the drawing context. -- -- This function is the forgetful version of drawli. -- Commonly, it is used to draw LocGraphic objects which have no -- answer. drawl :: InterpretUnit u => Anchor u -> LocImage u a -> GenTraceDrawing st u () -- | Draw a LocImage at the supplied Point taking the drawing style from -- the drawing context. -- -- The graphic representation of the Image is drawn in the Trace monad, -- and the result is returned. drawli :: InterpretUnit u => Anchor u -> LocImage u a -> GenTraceDrawing st u a -- | Draw a ConnectorGraphic with the supplied Anchors taking the drawing -- style from the drawing context. -- -- This function is the forgetful version of drawci. -- Commonly, it is used to draw ConnectorGraphic objects which -- have no answer. drawc :: InterpretUnit u => Anchor u -> Anchor u -> ConnectorImage u a -> GenTraceDrawing st u () -- | Draw a ConnectorImage with the supplied Points taking the drawing -- style from the drawing context. -- -- The graphic representation of the Image is drawn in the Trace monad, -- and the result is returned. drawci :: InterpretUnit u => Anchor u -> Anchor u -> ConnectorImage u a -> GenTraceDrawing st u a -- | Draw the object with the supplied grid coordinate. The actual position -- is scaled according to the snap_grid_factors in the -- drawing context. -- -- This function is the forgetful version of nodei. -- Commonly, it is used to draw LocGraphic objects which have no -- answer. node :: (Fractional u, InterpretUnit u) => (Int, Int) -> LocImage u a -> GenTraceDrawing st u () -- | Draw the object with the supplied grid coordinate. The actual position -- is scaled according to the snap_grid_factors in the -- drawing context. nodei :: (Fractional u, InterpretUnit u) => (Int, Int) -> LocImage u a -> GenTraceDrawing st u a -- | Draw a connector between two objects. The projection of the connector -- line is drawn on the line from center to center of the objects, the -- actual start and end points of the drawn line are the radial points on -- the objects borders that cross the projected line. -- -- This function is the forgetful version of drawrci. -- Commonly, it is used to draw LocGraphic objects which have no -- answer. drawrc :: (Real u, Floating u, InterpretUnit u, CenterAnchor a1, RadialAnchor a1, CenterAnchor a2, RadialAnchor a2, u ~ DUnit a1, u ~ DUnit a2) => a1 -> a2 -> ConnectorImage u a -> GenTraceDrawing st u () -- | Draw a connector between two objects. The projection of the connector -- line is drawn on the line from center to center of the objects, the -- actual start and end points of the drawn line are the radial points on -- the objects borders that cross the projected line. drawrci :: (Real u, Floating u, InterpretUnit u, CenterAnchor a1, RadialAnchor a1, CenterAnchor a2, RadialAnchor a2, u ~ DUnit a1, u ~ DUnit a2) => a1 -> a2 -> ConnectorImage u a -> GenTraceDrawing st u a instance UserStateM (GenTraceDrawing st u) instance DrawingCtxM (GenTraceDrawing st u) instance Monad (GenTraceDrawing st u) instance Applicative (GenTraceDrawing st u) instance Functor (GenTraceDrawing st u) -- | A Picture-with-implicit-context object. -- -- This is the corresponding type to Picture in the Wumpus-Core. -- -- Note - many of the composition functions are in destructor -- form. As Wumpus cannot make a Picture from an empty list of -- Pictures, destructor form decomposes the list into the -- head and rest as arguments in the function -- signature, rather than take a possibly empty list and have to throw an -- error. -- -- TODO - PosImage no longer supports composition operators, so better -- names are up for grabs... module Wumpus.Basic.Kernel.Drawing.CtxPicture -- | A Contextual Picture. -- --
--   CtxPicture = DrawingContext -> Maybe Picture
--   
-- -- This type corresponds to the Picture type in Wumpus-Core, but -- it is embedded with a DrawingContext (for font properties, fill -- colour etc.). The DrawingContext is embedded so that font metrics - -- loaded in IO can be passed into the pure world of -- TraceDrawing. -- -- Internally a context picture is a function from -- DrawingContext to (Maybe Picture). The Maybe -- represents that it is possible to construct empty Pictures, even -- though Wumpus-Core cannot render them. Just as the -- DrawingContext pushes font-metrics from the IO to the pure world, the -- Maybe lifts the problem of unrenderable Pictures into the API where -- client code must deal with it explicitly. -- -- (In practice, it is very unlikely a program will create empty pictures -- and runCtxPictureU can be used without worry). -- -- Note - pictures are fixed to the unit Double (representing -- PostScript points). Pictures are intentionally unsophisticated, any -- fine grained control of units should be delegated to the elements that -- build the picture (Graphics, LocGraphics, etc.). data CtxPicture -- | runCtxPicture : drawing_ctx * ctx_picture -> Maybe -- Picture -- -- Run a CtxPicture with the supplied DrawingContext -- producing a Picture. -- -- The resulting Picture may be empty. Wumpus-Core cannot generate empty -- pictures as they have no bounding box, so the result is wrapped within -- a Maybe. This delegates reponsibility for handling empty pictures to -- client code. runCtxPicture :: DrawingContext -> CtxPicture -> Maybe Picture -- | runCtxPictureU : drawing_ctx * ctx_picture -> Picture -- -- -- Unsafe version of runCtxPicture. -- -- This function throws a runtime error when supplied with an empty -- CtxPicture. runCtxPictureU :: DrawingContext -> CtxPicture -> Picture -- | drawTracing : trace_drawing -> CtxPicture -- -- Transform a TraceDrawing into a CtxPicture. drawTracing :: TraceDrawing u a -> CtxPicture -- | udrawTracing : scalar_unit_value * trace_drawing -> -- CtxPicture -- -- Variant of drawTracing with a phantom first argument - the -- phantom identifies the unit type of the TraceDrawing. It is not -- scurtinized at the value level. udrawTracing :: u -> TraceDrawing u a -> CtxPicture -- | mapCtxPicture : trafo * ctx_picture -> CtxPicture -- -- Apply a picture transformation function to the Picture warpped -- in a CtxPicture. mapCtxPicture :: (Picture -> Picture) -> CtxPicture -> CtxPicture -- | Draw a, move b so its center is at the same center -- as a, b is drawn over underneath in the zorder. -- --
--   a `cxpUniteCenter` b 
--   
uniteCenter :: CtxPicture -> CtxPicture -> CtxPicture -- | Center the picture at the supplied point. centeredAt :: CtxPicture -> DPoint2 -> CtxPicture instance AlignSpace CtxPicture instance Align CtxPicture instance CatSpace CtxPicture instance Concat CtxPicture instance ZConcat CtxPicture instance Monoid CtxPicture instance Translate CtxPicture instance Scale CtxPicture instance RotateAbout CtxPicture instance Rotate CtxPicture -- | Extended Graphic object - an AdvanceGraphic is a Graphic twinned with -- and advance vector. module Wumpus.Basic.Kernel.Objects.AdvObject -- | Advance vectors provide an idiom for drawing consecutive graphics. -- PostScript uses them to draw left-to-right text - each character has -- an advance vector for the width and as characters are drawn they -- successively displace the start point for the next character with -- their advance vector. -- -- Type alias for Vec2. type AdvanceVec u = Vec2 u -- | Extract the horizontal component of an advance vector. -- -- For left-to-right latin text, the vertical component of an advance -- vector is expected to be 0. Ingoring it seems permissible when drawing -- text. advanceH :: AdvanceVec u -> u -- | Extract the verticall component of an advance vector. advanceV :: AdvanceVec u -> u -- | Advance vector graphic - this partially models the PostScript -- show command which moves the current point by the -- advance (width) vector as each character is drawn. data AdvObject u a type DAdvObject a = AdvObject Double a type AdvGraphic u = AdvObject u (UNil u) type DAdvGraphic = AdvGraphic Double -- | Running an AdvObject produces a LocImage. runAdvObject :: InterpretUnit u => AdvObject u a -> LocImage u a -- | makeAdvObject : loc_context_function * image -> -- AdvObject -- -- Build an AdvObject from a context function (CF) that -- generates the answer displacement vector and a LocGraphic that -- draws the AdvObject. makeAdvObject :: InterpretUnit u => Query u (Vec2 u) -> LocImage u a -> AdvObject u a -- | emptyAdvObjectAU : AdvObject -- -- Build an empty AdvObject. -- -- The emptyAdvObject is treated as a null primitive by -- Wumpus-Core and is not drawn, the answer vector generated is -- the zero vector (V2 0 0). emptyAdvObject :: (Monoid a, InterpretUnit u) => AdvObject u a blankAdvObject :: (Monoid a, InterpretUnit u) => Vec2 u -> AdvObject u a -- | Draw the first AdvObject and use the advance vector to displace the -- second AdvObject. -- -- The final answer is the sum of both advance vectors. advance :: (Monoid a, InterpretUnit u) => AdvObject u a -> AdvObject u a -> AdvObject u a -- | Concatenate the list of AdvObjects with advance. advances :: (Monoid a, InterpretUnit u) => [AdvObject u a] -> AdvObject u a -- | Combine the AdvObjects using the answer vector of the first object -- plus the separator to move the start of the second object. advspace :: (Monoid a, InterpretUnit u) => Vec2 u -> AdvObject u a -> AdvObject u a -> AdvObject u a -- | List version of nextSpace. evenspace :: (Monoid a, InterpretUnit u) => Vec2 u -> [AdvObject u a] -> AdvObject u a -- | Repeat the AdvObject n times, moving each time with -- advance. advrepeat :: (Monoid a, InterpretUnit u) => Int -> AdvObject u a -> AdvObject u a -- | Concatenate the list of AdvObjects, going next and adding the -- separator at each step. punctuate :: (Monoid a, InterpretUnit u) => AdvObject u a -> [AdvObject u a] -> AdvObject u a -- | Render the supplied AdvObject, but swap the result advance for the -- supplied vector. This function has behaviour analogue to fill -- in the wl-pprint library. advfill :: InterpretUnit u => Vec2 u -> AdvObject u a -> AdvObject u a instance (Monoid a, InterpretUnit u) => Monoid (AdvObject u a) instance DrawingCtxM (AdvObject u) instance Monad (AdvObject u) instance Applicative (AdvObject u) instance Functor (AdvObject u) instance Monoid DAV -- | LocThetaImage and LocThetaGraphic types - these are functional types -- from the DrawingContext, start point and angle of inclination to a -- graphic primitive. module Wumpus.Basic.Kernel.Objects.LocThetaImage type LocThetaGraphic u = LocThetaImage u (UNil u) -- | LocThetaImage - function from start point, inclination and -- DrawingContext to a polymorphic answer and a graphic -- primitive (PrimW). data LocThetaImage u a -- | Type specialized version of LocThetaGraphic. type DLocThetaGraphic = LocThetaGraphic Double -- | Type specialized version of LocThetaImage. type DLocThetaImage a = LocThetaImage Double a data LocThetaQuery u a runLocThetaImage :: InterpretUnit u => DrawingContext -> Point2 u -> Radian -> LocThetaImage u a -> PrimResult u a runLocThetaQuery :: InterpretUnit u => DrawingContext -> Point2 u -> Radian -> LocThetaQuery u a -> a stripLocThetaImage :: LocThetaImage u a -> LocThetaQuery u a liftLocThetaQuery :: LocThetaQuery u a -> LocThetaImage u a promoteLocTheta :: InterpretUnit u => (Point2 u -> Radian -> Image u a) -> LocThetaImage u a applyLocTheta :: InterpretUnit u => LocThetaImage u a -> Point2 u -> Radian -> Image u a supplyLocTheta :: InterpretUnit u => Point2 u -> Radian -> LocThetaImage u a -> Image u a qpromoteLocTheta :: InterpretUnit u => (Point2 u -> Radian -> Query u a) -> LocThetaQuery u a qapplyLocTheta :: InterpretUnit u => LocThetaQuery u a -> Point2 u -> Radian -> Query u a -- | Having empty at the specific LocThetaImage type is -- useful. emptyLocThetaImage :: Monoid a => LocThetaImage u a -- | Downcast a LocThetaImage function by applying it to the -- supplied angle, making a LocImage. incline :: InterpretUnit u => LocThetaImage u a -> Radian -> LocImage u a atIncline :: InterpretUnit u => LocThetaImage u a -> Point2 u -> Radian -> Image u a -- | Flipped version of incline supplyIncline :: InterpretUnit u => Radian -> LocThetaImage u a -> LocImage u a instance UConvert LocThetaImage instance Decorate LocThetaImage instance DrawingCtxM (LocThetaQuery u) instance DrawingCtxM (LocThetaImage u) instance Monoid a => Monoid (LocThetaQuery u a) instance Monoid a => Monoid (LocThetaImage u a) instance Monad (LocThetaQuery u) instance Monad (LocThetaImage u) instance Applicative (LocThetaQuery u) instance Applicative (LocThetaImage u) instance Functor (LocThetaQuery u) instance Functor (LocThetaImage u) -- | Primitive drawings - text, paths, lines, rectangles, disks, -- ellipses... -- -- All the primitives take their drawing properties (colour, line width, -- etc.) from the DrawingContext. module Wumpus.Basic.Kernel.Objects.DrawingPrimitives -- | locPP : [next_vector] -> LocImage PrimPath -- -- Create a path query - i.e. a functional type from Point to -- PrimPath. -- -- This is the analogue to vectorPath in Wumpus-Core, -- but the result is produced within the DrawingContext. locPP :: InterpretUnit u => [Vec2 u] -> LocQuery u PrimPath -- | emptyLocPP : (Point ~> PrimPath) -- -- Create an empty path query - i.e. a functional type from -- Point to PrimPath. -- -- This is the analogue to emptyPath in Wumpus-Core, -- but the result is produced within the DrawingContext. emptyLocPP :: InterpretUnit u => LocQuery u PrimPath -- | vertexPP : (Point ~> PrimPath) -- -- Create a PrimPath made of straight line segments joining the supplied -- points. -- -- This is the analogue to vertexPrimPath in Wumpus-Core, -- but it is polymorphic on unit. vertexPP :: InterpretUnit u => [Point2 u] -> Query u PrimPath -- | curvePP : (Point ~> PrimPath) -- -- Create a path made of curve segments joining the supplied points. -- -- This is the analogue to curvedPrimPath in Wumpus-Core, -- but it is polymorphic on unit. curvePP :: InterpretUnit u => [Point2 u] -> Query u PrimPath dcPath :: PathMode -> PrimPath -> Graphic u -- | dcOpenPath : path -> Graphic -- -- This is the analogue to the ostroke function in -- Wumpus-Core, but the drawing properties (colour, line width, -- etc.) are taken from the implicit DrawingContext. dcOpenPath :: PrimPath -> Graphic u -- | dcClosedPath : DrawStyle * path -> Graphic -- -- Draw a closed path according to the supplied DrawStyle ( fill | stroke -- | fill_stroke). dcClosedPath :: DrawMode -> PrimPath -> Graphic u -- | dcTextlabel : string -> LocGraphic -- -- Create a text LocGraphic - i.e. a functional type from Point -- to Graphic. -- -- The implicit point of the LocGraphic is the baseline left. -- -- This is the analogue to textlabel in Wumpus-core, but -- the text properties (font family, font size, colour) are taken from -- the implicit DrawingContext. dcTextlabel :: InterpretUnit u => String -> LocGraphic u -- | dcRTextlabel : string -> LocThetaGraphic -- -- Create a text LocThetaGraphic - i.e. a functional type from -- Point and Angle to Graphic. -- -- The implicit point of the LocGraphic is the baseline left, the -- implicit angle is rotation factor of the text. -- -- Note - rotated text often does not render well in PostScript or SVG. -- Rotated text should be used sparingly. -- -- This is the analogue to rtextlabel in Wumpus-core. dcRTextlabel :: InterpretUnit u => String -> LocThetaGraphic u -- | dcEscapedlabel : escaped_text -> LocGraphic -- -- Create a text LocGraphic - i.e. a functional type from Point -- to Graphic. -- -- The implicit point of the LocGraphic is the baseline left. -- -- This is the analogue to escapedlabel in Wumpus-core, -- but the text properties (font family, font size, colour) are taken -- from the implicit DrawingContext. dcEscapedlabel :: InterpretUnit u => EscapedText -> LocGraphic u -- | dcREscapedlabel : escaped_text -> LocThetaGraphic -- -- Create a text LocThetaGraphic - i.e. a functional type from -- Point and Angle to Graphic. -- -- The implicit point of the LocGraphic is the baseline left, the -- implicit angle is rotation factor of the text. -- -- Note - rotated text often does not render well in PostScript or SVG. -- Rotated text should be used sparingly. -- -- This is the analogue to rescapedlabel in Wumpus-core, -- but the text properties (font family, font size, colour) are taken -- from the implicit DrawingContext. dcREscapedlabel :: InterpretUnit u => EscapedText -> LocThetaGraphic u -- | hkernLine : [kern_char] -> LocGraphic -- -- Create a horizontally kerned text LocGraphic - i.e. a -- functional type from Point to Graphic. -- -- The implicit point of the LocGraphic is the baseline left. -- -- This is the analogue to hkernlabel in Wumpus-core, but -- the text properties (font family, font size, colour) are taken from -- the implicit DrawingContext. hkernLine :: InterpretUnit u => [KernChar u] -> LocGraphic u -- | vkernLine : [kern_char] -> LocGraphic -- -- Create a vertically kerned text LocGraphic - i.e. a functional -- type from Point to Graphic. -- -- The implicit point of the LocGraphic is the baseline left. -- -- This is the analogue to vkernlabel in Wumpus-core, but -- the text properties (font family, font size, colour) are taken from -- the implicit DrawingContext. vkernLine :: InterpretUnit u => [KernChar u] -> LocGraphic u -- | straightLine : start_point * end_point -> LocGraphic -- -- -- Create a straight line Graphic, the start and end point are -- supplied explicitly. -- -- The line properties (colour, pen thickness, etc.) are taken from the -- implicit DrawingContext. straightLine :: InterpretUnit u => Point2 u -> Point2 u -> Graphic u -- | locStraightLine : vec_to -> LocGraphic -- -- Create a stright line LocGraphic - i.e. a functional type -- from Point to Graphic. -- -- The implicit point of the LocGraphic is the start point, the end point -- is calculated by displacing the start point with the supplied vector. -- -- The line properties (colour, pen thickness, etc.) are taken from the -- implicit DrawingContext. locStraightLine :: InterpretUnit u => Vec2 u -> LocGraphic u -- | curveLine : start_point * control_point1 * -- control_point2 * end_point -> Graphic -- -- Create a Bezier curve Graphic, all control points are supplied -- explicitly. -- -- The line properties (colour, pen thickness, etc.) are taken from the -- implicit DrawingContext. curvedLine :: InterpretUnit u => Point2 u -> Point2 u -> Point2 u -> Point2 u -> Graphic u -- | straightConnector : start_point * end_point -> -- Connector -- -- Create a straight line Graphic, the start and end point are -- supplied implicitly. -- -- The line properties (colour, pen thickness, etc.) are taken from the -- implicit DrawingContext. straightConnector :: InterpretUnit u => ConnectorGraphic u -- | dcCircle : DrawStyle * radius -> LocGraphic -- -- Create a circle LocGraphic - the implicit point is center. The -- circle is drawn with four Bezier curves. -- -- The respective line or fill properties for the DrawStyle are -- taken from the implicit DrawingContext. dcCircle :: InterpretUnit u => DrawMode -> u -> LocGraphic u -- | strokedEllipse : x_radius * y_radius -> LocGraphic -- -- -- Create a stroked ellipse LocGraphic - the implicit point is -- center. The ellipse is drawn with four Bezier curves. -- -- The line properties (colour, pen thickness, etc.) are taken from the -- implicit DrawingContext. dcEllipse :: InterpretUnit u => DrawMode -> u -> u -> LocGraphic u -- | dcREllipse : x_radius * y_radius -> LocGraphic -- -- Create a bordered ellipse LocThetaGraphic - the implicit point -- is center and the angle is rotation about the center. The ellipse is -- drawn with four Bezier curves. -- -- The background fill colour and the outline stroke properties are taken -- from the implicit DrawingContext. dcREllipse :: InterpretUnit u => DrawMode -> u -> u -> LocThetaGraphic u -- | strokedRectangle : style * width * height -> -- LocGraphic -- -- Create a stroked rectangle LocGraphic - the implicit point is -- bottom-left. -- -- The line properties (colour, pen thickness, etc.) are taken from the -- implicit DrawingContext. dcRectangle :: InterpretUnit u => DrawMode -> u -> u -> LocGraphic u -- | dcDisk : radius -> LocGraphic -- -- Create a circle LocGraphic - the implicit point is the center. -- -- This is a efficient representation of circles using PostScript's -- arc or SVG's circle in the generated output. -- However, stroked-circles do not draw well after non-uniform scaling - -- the pen width is scaled as well as the shape. -- -- For stroked circles that can be adequately scaled, use dcCircle -- instead. -- -- The fill or stroke properties for the respective DrawStyle are taken -- from the implicit DrawingContext. dcDisk :: InterpretUnit u => DrawMode -> u -> LocGraphic u -- | strokeEllipseDisk : x_radius * y_radius -> LocGraphic -- -- -- Create a stroked ellipse LocGraphic - the implicit point is the -- center. -- -- This is a efficient representation of circles using PostScript's -- arc or SVG's ellipse in the generated output. -- However, stroked ellipses do not draw well after non-uniform scaling - -- the pen width is scaled as well as the shape. -- -- For stroked ellipses that can be adequately scaled, use -- strokedEllipse instead. -- -- The line properties (colour, pen thickness, etc.) are taken from the -- implicit DrawingContext. dcEllipseDisk :: InterpretUnit u => DrawMode -> u -> u -> LocGraphic u -- | dcArc : radius * apex_angle -- -- Always open-stroked. dcArc :: (Floating u, InterpretUnit u) => u -> Radian -> LocThetaGraphic u -- | Extended Graphic object - a rectangular positionable Image. -- -- This graphic object has a more flexible API for positioning than other -- graphic objects. Rather than a LocGraphic which supports a single -- method of positioning at some start-point, a PosGraphic can -- be drawn at its center or locations on its outer rectangle. module Wumpus.Basic.Kernel.Drawing.PosObject -- | A positionable "Object". data GenPosObject st u a type GenPosGraphic st u = GenPosObject st u (UNil u) -- | Type synonym for GenPosObject () u a, a PosObject without -- user state. type PosObject u a = GenPosObject () u a -- | Version of PosObject specialized to Double for the unit type. type DPosObject a = PosObject Double a -- | Version of PosObject with answer specialized to UNil. type PosGraphic u = PosObject u (UNil u) -- | Version of PosGraphic specialized to Double for the unit type. type DPosGraphic = PosGraphic Double -- | Running an PosObject produces a LocImage. runGenPosObject :: InterpretUnit u => RectAddress -> st -> GenPosObject st u a -> LocImage u (a, st) evalGenPosObject :: InterpretUnit u => RectAddress -> st -> GenPosObject st u a -> LocImage u a execGenPosObject :: InterpretUnit u => RectAddress -> st -> GenPosObject st u a -> LocImage u st runPosObject :: InterpretUnit u => RectAddress -> PosObject u a -> LocImage u a -- | Run a PosObject producing a LocImage (BoundingBox u). runPosObjectBBox :: InterpretUnit u => RectAddress -> PosObject u a -> LocImage u (BoundingBox u) -- | makePosObject : object_pos * loc_image -> PosObject -- -- -- Create a PosObject from an Orientation describing how it -- is orientated within a border rectangle and a LocImage that -- draws it. -- -- This is the primary constructor for PosObjects. Because the -- PosObject type is considered as a specialized object it does not have -- the range of functions of LocImage or LocThetaImage. makePosObject :: InterpretUnit u => Query u (Orientation u) -> LocImage u a -> GenPosObject st u a -- | emptyPosObject : PosObject -- -- Build an empty PosGraphicObject. emptyPosObject :: (Monoid a, InterpretUnit u) => GenPosObject st u a elaboratePosObject :: (Fractional u, Ord u, InterpretUnit u) => ZOrder -> RectAddress -> LocGraphic u -> GenPosObject st u a -> GenPosObject st u a decoratePosObject :: InterpretUnit u => ZOrder -> (Orientation u -> LocGraphic u) -> GenPosObject st u a -> GenPosObject st u a -- | Extend the orientation. extendPosObject :: InterpretUnit u => u -> u -> u -> u -> GenPosObject st u a -> GenPosObject st u a -- | Note - this is a bad API, it would be better to have padders and -- fillers and not expose the orientation directly. mapOrientation :: InterpretUnit u => (Orientation u -> Orientation u) -> GenPosObject st u a -> GenPosObject st u a -- | Illustrate a PosObject by super-imposing its -- Orientation. -- -- This turns the PosObject into a LocImage drawn at the -- locus of the PosObject. illustratePosObject :: InterpretUnit u => PosObject u a -> LocGraphic u -- | Note - no margins are added to the containing rectangle. -- -- To get a Char with margins, use posText instead: -- --
--   posText ['1']
--   
posChar :: InterpretUnit u => Char -> GenPosGraphic st u posEscChar :: InterpretUnit u => EscapedChar -> GenPosGraphic st u posCharUpright :: InterpretUnit u => Char -> GenPosGraphic st u posEscCharUpright :: InterpretUnit u => EscapedChar -> GenPosGraphic st u -- | Primtive builder that does not add margins. posCharPrim :: InterpretUnit u => Either Char EscapedChar -> GenPosGraphic st u posText :: InterpretUnit u => String -> GenPosGraphic st u posEscText :: InterpretUnit u => EscapedText -> GenPosGraphic st u posTextUpright :: InterpretUnit u => String -> GenPosGraphic st u posEscTextUpright :: InterpretUnit u => EscapedText -> GenPosGraphic st u -- | Primtive builder that does not add margins. posTextPrim :: InterpretUnit u => Either String EscapedText -> GenPosGraphic st u multilinePosText :: (Fractional u, InterpretUnit u) => VAlign -> String -> PosGraphic u multilinePosEscText :: (Fractional u, InterpretUnit u) => VAlign -> [EscapedText] -> GenPosGraphic st u -- | Note - for single line text. rposText :: (Real u, Floating u, InterpretUnit u) => Radian -> String -> GenPosGraphic st u -- | Note - for single line text. rposEscText :: (Real u, Floating u, InterpretUnit u) => Radian -> EscapedText -> GenPosGraphic st u rposChar :: (Real u, Floating u, InterpretUnit u) => Radian -> Char -> GenPosGraphic st u rposEscChar :: (Real u, Floating u, InterpretUnit u) => Radian -> EscapedChar -> GenPosGraphic st u posHKernText :: InterpretUnit u => [KernChar u] -> GenPosGraphic st u -- | The query should retrieve the width of one char. monospaceText :: InterpretUnit u => Query u u -> String -> GenPosGraphic st u -- | The query should retrieve the width of one char. monospaceEscText :: InterpretUnit u => Query u u -> EscapedText -> GenPosGraphic st u instance (Monoid a, InterpretUnit u) => AlignSpace (GenPosObject st u a) instance Monoid a => Align (GenPosObject st u a) instance (Monoid a, InterpretUnit u) => CatSpace (GenPosObject st u a) instance Monoid a => Concat (GenPosObject st u a) instance (Monoid a, InterpretUnit u) => ZConcat (GenPosObject st u a) instance UserStateM (GenPosObject st u) instance DrawingCtxM (GenPosObject st u) instance (Monoid a, InterpretUnit u) => Monoid (GenPosObject st u a) instance Monad (GenPosObject st u) instance Applicative (GenPosObject st u) instance Functor (GenPosObject st u) -- | Helpers for working with Images and LocImages that produce bounding -- boxes. module Wumpus.Basic.Kernel.Objects.Bounded type BoundedGraphic u = Image u (BoundingBox u) type BoundedLocGraphic u = LocImage u (BoundingBox u) type BoundedLocThetaGraphic u = LocThetaImage u (BoundingBox u) -- | centerOrthoBBox : theta * bbox -> BBox -- -- Rotate a bounding box by theta about its center. Take the new -- bounding box. -- -- Remember that bounding boxes are always orthonormal rectangles, so the -- dimensions as well as the positions may change under rotation. centerOrthoBBox :: (Real u, Floating u, Ord u) => Radian -> BoundingBox u -> BoundingBox u -- | Build an empty LocGraphic returning a bounding box. -- -- The emptyBoundedLocGraphic is treated as a null -- primitive by Wumpus-Core and is not drawn, although it -- does generate the minimum bounding box with both the bottom-left and -- upper-right corners at the implicit start point. emptyBoundedLocGraphic :: InterpretUnit u => BoundedLocGraphic u -- | Build an empty LocThetaGraphic returning a bounding box. -- -- The emptyBoundedLocThetaGraphic is treated as a null -- primitive by Wumpus-Core and is not drawn, although it -- does generate the minimum bounding box with both the bottom-left and -- upper-right corners at the implicit start point emptyBoundedLocThetaGraphic :: InterpretUnit u => BoundedLocThetaGraphic u -- | Draw a BoundedGraphic, illustrating the bounding box. illustrateBoundedGraphic :: InterpretUnit u => Image u (BoundingBox u) -> Image u (BoundingBox u) -- | Draw a BoundedLocGraphic, illustrating the bounding box. illustrateBoundedLocGraphic :: InterpretUnit u => LocImage u (BoundingBox u) -> LocImage u (BoundingBox u) -- | Draw a BoundedLocThetaGraphic, illustrating the bounding box. illustrateBoundedLocThetaGraphic :: InterpretUnit u => LocThetaImage u (BoundingBox u) -> LocThetaImage u (BoundingBox u) -- | Draw a bounding box as a stroked rectangle with dotted lines. bbrectangle :: InterpretUnit u => BoundingBox u -> Graphic u -- | boundedRect : style * width * height -> LocGraphic -- -- -- Create a stroked rectangle - the implicit start point is -- bottom-left, return the bounding box of the rectangle as the -- answer. -- -- The line properties (colour, pen thickness, etc.) are taken from the -- implicit DrawingContext. boundedRect :: InterpretUnit u => DrawMode -> u -> u -> BoundedLocGraphic u -- | Trails - prototype paths. Less resource heavy than the Path -- object in Wumpus-Drawing. -- -- CatTrail supports concatenation. AnaTrail supports -- initial displacement - this can account for drawing rectangles -- from their center, for example. module Wumpus.Basic.Kernel.Objects.Trail -- | Trail segment - trails are prototype paths, so the are built -- from the usual straight lines and Bezier curves. data TrailSegment u TLine :: (Vec2 u) -> TrailSegment u TCurve :: (Vec2 u) -> (Vec2 u) -> (Vec2 u) -> TrailSegment u -- | Trail supporting concatenation. data CatTrail u -- | Trail with an initial (undrawn) displacement - an anacrusis. -- -- This allows trails to represent centered objects. data AnaTrail u -- | Render an AnaTrail to make a drawable LocGraphic. renderAnaTrail :: InterpretUnit u => PathMode -> AnaTrail u -> LocGraphic u -- | Render a CatTrail to make a drawable LocGraphic. renderCatTrail :: InterpretUnit u => PathMode -> CatTrail u -> LocGraphic u -- | Destructor for the opaque AnaTrail type. destrAnaTrail :: AnaTrail u -> (Vec2 u, [TrailSegment u]) -- | Destructor for the opaque CatTrail type. destrCatTrail :: CatTrail u -> [TrailSegment u] -- | Turn a CatTrail into a AnaTrail. anaCatTrail :: Vec2 u -> CatTrail u -> AnaTrail u modifyAna :: (Vec2 u -> Vec2 u) -> AnaTrail u -> AnaTrail u -- | Create a AnaTrail from the vector list - each vector in the input list -- iterates to the start point rather then the cumulative tip. -- -- When the AnaTrail is run, the supplied point is the locus of -- the path and it does not form part of the path proper. -- -- Like trailStartIsLocus, this constructor is typically used to -- make shape paths. Some shapes are easier to express as iterated -- displacements of the center rather than turtle drawing. trailIterateLocus :: Num u => [Vec2 u] -> AnaTrail u anaTrailPoints :: InterpretUnit u => AnaTrail u -> LocQuery u [Point2 u] catline :: Vec2 u -> CatTrail u catcurve :: Vec2 u -> Vec2 u -> Vec2 u -> CatTrail u -- | Alternative to catline, specifying the vector components -- rather the vector itself. -- -- (cf. orthoVec from Wumpus-Core) orthoCatTrail :: Floating u => u -> u -> Radian -> CatTrail u -- | Form a Bezier CatTrail from the vectors between four control points. diffCurve :: Num u => Point2 u -> Point2 u -> Point2 u -> Point2 u -> CatTrail u -- | Form a CatTrail from the linear segment joining the list of points. -- -- Some configurations of vectors seem easier to specify using located -- points then making them coordinate free by taking the joining vectors. diffLines :: Num u => [Point2 u] -> CatTrail u -- | rectangleTrail : width * height -> AnaTrail rectangleTrail :: Fractional u => u -> u -> AnaTrail u -- | diamondTrail : half_width * half_height -> AnaTrail -- diamondTrail :: Num u => u -> u -> AnaTrail u -- | polygonTrail : num_points * radius -> AnaTrail polygonTrail :: Floating u => Int -> u -> AnaTrail u -- | wedgeTrail : radius * apex_angle -- -- Wedge is drawn at the apex. wedgeTrail :: (Real u, Floating u) => u -> Radian -> Radian -> AnaTrail u trail_up :: Num u => u -> CatTrail u trail_down :: Num u => u -> CatTrail u trail_left :: Num u => u -> CatTrail u trail_right :: Num u => u -> CatTrail u trail_north :: Num u => u -> CatTrail u trail_south :: Num u => u -> CatTrail u trail_east :: Num u => u -> CatTrail u trail_west :: Num u => u -> CatTrail u trail_north_east :: Floating u => u -> CatTrail u trail_north_west :: Floating u => u -> CatTrail u trail_south_east :: Floating u => u -> CatTrail u trail_south_west :: Floating u => u -> CatTrail u trail_up_left :: Num u => u -> CatTrail u trail_up_right :: Num u => u -> CatTrail u trail_down_left :: Num u => u -> CatTrail u trail_down_right :: Num u => u -> CatTrail u trail_para :: Floating u => u -> Radian -> CatTrail u trail_perp :: Floating u => u -> Radian -> CatTrail u trail_theta_up :: Floating u => u -> Radian -> CatTrail u trail_theta_down :: Floating u => u -> Radian -> CatTrail u trail_theta_left :: Floating u => u -> Radian -> CatTrail u trail_theta_right :: Floating u => u -> Radian -> CatTrail u trail_theta_north :: Floating u => u -> Radian -> CatTrail u trail_theta_south :: Floating u => u -> Radian -> CatTrail u trail_theta_east :: Floating u => u -> Radian -> CatTrail u trail_theta_west :: Floating u => u -> Radian -> CatTrail u trail_theta_north_east :: Floating u => u -> Radian -> CatTrail u trail_theta_north_west :: Floating u => u -> Radian -> CatTrail u trail_theta_south_east :: Floating u => u -> Radian -> CatTrail u trail_theta_south_west :: Floating u => u -> Radian -> CatTrail u trail_theta_up_left :: Floating u => u -> Radian -> CatTrail u trail_theta_up_right :: Floating u => u -> Radian -> CatTrail u trail_theta_down_left :: Floating u => u -> Radian -> CatTrail u trail_theta_down_right :: Floating u => u -> Radian -> CatTrail u -- | Return the line a-o when supplied length of b-o and -- the grazing angle boa: -- --
--     a
--     .\
--     . \
--   ..b..o
--   
-- -- This is useful for building arrowhead vectors. trail_theta_adj_grazing :: Floating u => u -> Radian -> Radian -> CatTrail u -- | Return the line o-c when supplied length of b-o and -- the grazing angle boc: -- --
--   ..b..o
--     . /
--     ./
--     c
--   
-- -- This is useful for building arrowhead vectors. trail_theta_bkwd_adj_grazing :: Floating u => u -> Radian -> Radian -> CatTrail u -- | semicircleCW : base_vector -> CatTrail -- -- Make an open semicircle from two Bezier curves. -- -- Although this function produces an approximation of a semicircle, the -- approximation seems fine in practice. semicircleTrail :: (Real u, Floating u) => ClockDirection -> Vec2 u -> CatTrail u -- | semicircleTrail : clock_direction * ry * base_vector -> -- CatTrail -- -- Make an open semiellipse from two Bezier curves. -- -- Although this function produces an approximation of a semiellipse, the -- approximation seems fine in practice. semiellipseTrail :: (Real u, Floating u) => ClockDirection -> u -> Vec2 u -> CatTrail u -- | minorCircleSweep : clock_direction * angle * radius * -- inclination -> CatTrail -- --
--   ang should be in the range 0 < ang <= 90deg.
--   
minorCircleSweep :: (Real u, Floating u) => ClockDirection -> Radian -> u -> Radian -> CatTrail u -- | circleSweep : clock_direction * apex_angle * radius * -- inclination -> CatTrail -- --
--   ang should be in the range 0 < ang < 360deg.
--   
-- --
--   if   0 < ang <=  90 returns 1 segment
--   if  90 < ang <= 180 returns 2 segments
--   if 180 < ang <= 270 returns 3 segments
--   if 270 < ang <  360 returns 4 segmenets
--   
circleSweep :: (Real u, Floating u) => ClockDirection -> Radian -> u -> Radian -> CatTrail u circularArc :: (Real u, Floating u) => ClockDirection -> Radian -> u -> Radian -> CatTrail u sineWave :: (Real u, Floating u) => Int -> u -> Radian -> CatTrail u -- | One-phase sine wave. Height is parametric. sineWave1 :: (Real u, Floating u) => u -> u -> Radian -> CatTrail u squareWave :: Floating u => Int -> u -> Radian -> CatTrail u sawtoothWave :: (Real u, Floating u) => Int -> u -> Radian -> CatTrail u -- | Proper semicircles do not make a good squiggle (it needs a bit of -- pinch). squiggleWave :: (Real u, Floating u) => Int -> u -> Radian -> CatTrail u semicircleWave :: (Real u, Floating u) => ClockDirection -> Int -> u -> Radian -> CatTrail u -- | triCurve : clock_direction * base_width * height * -- base_inclination -> CatTrail -- -- Curve in a triangle - base_width and height are expected to be -- positive. triCurve :: Floating u => ClockDirection -> u -> u -> Radian -> CatTrail u -- | rectCurve : clock_direction * base_width * height * -- base_inclination -> CatTrail -- -- Curve in a rectangle. rectCurve :: Floating u => ClockDirection -> u -> u -> Radian -> CatTrail u -- | Curve in a trapezium. trapCurve :: Floating u => ClockDirection -> u -> u -> Radian -> Radian -> CatTrail u -- | Curve in half a bowtie. bowCurve :: Floating u => ClockDirection -> u -> u -> Radian -> CatTrail u -- | Wedge curve formed inside a bowtie rotated by 90deg. wedgeCurve :: Floating u => ClockDirection -> u -> u -> Radian -> CatTrail u -- | Variation of wedge curve that draws a loop. loopCurve :: Floating u => ClockDirection -> u -> u -> Radian -> CatTrail u instance (Ord u, Tolerance u) => Eq (TrailSegment u) instance (Ord u, Tolerance u) => Ord (TrailSegment u) instance Show u => Show (TrailSegment u) instance (Ord u, Tolerance u) => Eq (AnaTrail u) instance (Ord u, Tolerance u) => Ord (AnaTrail u) instance Show u => Show (AnaTrail u) instance Monoid (CatTrail u) instance Functor TrailSegment -- | Chaining LocGraphics. module Wumpus.Basic.Kernel.Drawing.Chain data GenChain st u a type Chain u a = GenChain () u a type DChain a = Chain Double a -- | scheme_start is a function from the origin to state. -- -- For instance, we might want to cache the origin - this would not be -- possible if start was just a pure cst value. data ChainScheme u ChainScheme :: (Point2 u -> cst) -> (Point2 u -> cst -> (Point2 u, cst)) -> ChainScheme u chain_init :: ChainScheme u -> Point2 u -> cst chain_step :: ChainScheme u -> Point2 u -> cst -> (Point2 u, cst) runGenChain :: InterpretUnit u => ChainScheme u -> st -> GenChain st u a -> LocImage u (a, st) -- | Forget the user state LocImage, just return the answer. evalGenChain :: InterpretUnit u => ChainScheme u -> st -> GenChain st u a -> LocImage u a -- | Forget the answer, just return the user state. execGenChain :: InterpretUnit u => ChainScheme u -> st -> GenChain st u a -> LocImage u st stripGenChain :: InterpretUnit u => ChainScheme u -> st -> GenChain st u a -> LocQuery u (a, st) runChain :: InterpretUnit u => ChainScheme u -> Chain u a -> LocImage u a runChain_ :: InterpretUnit u => ChainScheme u -> Chain u a -> LocGraphic u -- | Demand a point on the Chain and draw the LocImage at it. chain1 :: InterpretUnit u => LocImage u a -> GenChain st u a -- | Demand the next position, but draw nothing. chainSkip_ :: InterpretUnit u => GenChain st u () -- | Chain a list of images, each demanding a succesive start point. chainMany :: InterpretUnit u => [LocImage u a] -> GenChain st u (UNil u) -- | Replicate a LocImage n times along a Chain. chainReplicate :: InterpretUnit u => Int -> LocImage u a -> GenChain st u (UNil u) -- | Return the count of chain steps. chainCount :: GenChain st u Int -- | General scheme - iterate the next point with the supplied function. iterationScheme :: (Point2 u -> Point2 u) -> ChainScheme u -- | General scheme - displace successively by the elements of the list of -- vectors. -- -- Note - the list is cycled to make the chain infinite. sequenceScheme :: Num u => [Vec2 u] -> ChainScheme u -- | Derive a ChainScheme from a CatTrail. -- -- Note - this iterates the control points of curves, it does not iterate -- points on the curve. catTrailScheme :: Num u => CatTrail u -> ChainScheme u -- | Build an (infinite) ChainScheme for a prefix list of counted schemes -- and a final scheme that runs out to infinity. countingScheme :: [(Int, ChainScheme u)] -> ChainScheme u -> ChainScheme u horizontalScheme :: Num u => u -> ChainScheme u verticalScheme :: Num u => u -> ChainScheme u -- | Generate a tabular scheme going rowwise (left-to-right) and downwards. -- -- TODO - should probably account for the initial position... rowwiseTableScheme :: Num u => Int -> (u, u) -> ChainScheme u -- | Generate a tabular scheme going columwise (top-to-bottom) and -- rightwards. -- -- TODO - should probably account for the initial position... columnwiseTableScheme :: Num u => Int -> (u, u) -> ChainScheme u distribRowwiseTable :: (Monoid a, InterpretUnit u) => Int -> (u, u) -> [LocImage u a] -> LocImage u a duplicateRowwiseTable :: (Monoid a, InterpretUnit u) => Int -> Int -> (u, u) -> LocImage u a -> LocImage u a distribColumnwiseTable :: (Monoid a, InterpretUnit u) => Int -> (u, u) -> [LocImage u a] -> LocImage u a duplicateColumnwiseTable :: (Monoid a, InterpretUnit u) => Int -> Int -> (u, u) -> LocImage u a -> LocImage u a -- | TODO - account for CW CCW or just rely on +ve -ve angles?... radialChainScheme :: Floating u => u -> Radian -> Radian -> ChainScheme u instance Monoid a => Monoid (GenChain st u a) instance InterpretUnit u => LocationM (GenChain st u) instance UserStateM (GenChain st u) instance DrawingCtxM (GenChain st u) instance Monad (GenChain st u) instance Applicative (GenChain st u) instance Functor (GenChain st u) -- | Import shim for Wumpus.Basic.Kernel modules. -- -- Kernel.Base - low-level objects, general enumerations, unit -- and DrawingContext support. DrawingContext is -- comparative to the graphics state in PostScript, but it is a -- read-only environment (cf. the Reader monad). Like the Reader monad it -- supports branching update through local - here called -- localize. -- -- Kernel.Objects - "elementary" drawing objects, plus some -- catalogues of named, predefined drawing objects (DrawingPrimitives) -- and useful operations (named vectors - Displacement). -- -- Kernel.Drawing - "collective" drawing objects. -- Drawing is considered a higher layer than Objects, -- so there should be dependencies only from Drawing to -- Objects. module Wumpus.Basic.Kernel -- | Font load monad handling IO (file system access), failure and logging. module Wumpus.Basic.System.FontLoader.FontLoadMonad data FontLoadIO a runFontLoadIO :: FontLoadIO a -> IO (Either FontLoadMsg a, FontLoadLog) evalFontLoadIO :: FontLoadIO a -> IO (Either FontLoadMsg a) loadError :: FontLoadMsg -> FontLoadIO a tellLoadMsg :: String -> FontLoadIO () -- | Promote an IO action into the the FontLoadIO monad. -- -- This function is equivalent to liftIO. promoteIO :: IO a -> FontLoadIO a promoteEither :: Either FontLoadMsg a -> FontLoadIO a runParserFLIO :: FilePath -> Parser Char a -> FontLoadIO a -- | The standard monadic sequence would finish on first fail for -- the FontLoadIO monad. As we want to be able to sequence the loading of -- a list of fonts, this is not really the behaviour we want for Wumpus. -- Instead we prefer to use fallback metrics and produce an inaccurate -- drawing on a font load error rather than fail and produce no drawing. sequenceAll :: [FontLoadIO a] -> FontLoadIO [a] -- | Afm files do not have a default advance vec so use the monospace -- default. -- -- Afm files hopefully have CapHeight and FontBBox -- properties in the header. Use the monospace default only if they are -- missing. buildAfmFontProps :: MonospaceDefaults AfmUnit -> AfmFile -> FontLoadIO (FontProps AfmUnit) checkFontPath :: FilePath -> FilePath -> FontLoadIO FilePath instance Monad FontLoadIO instance Functor FontLoadIO -- | Top-level AFM V4.1 font loader. -- -- Use this module to build a font loader if you want to work with the -- Adobe metrics sets, but find the simpleFontLoader in -- Wumpus.Basic.System.FontLoader too inflexible. module Wumpus.Basic.System.FontLoader.AfmTopLevel -- | loadAfmFontMetrics : path_to_afm_fonts * [font_name] -> -- IO FontLoadResult -- -- Load the supplied list of fonts. -- -- Note - if a font fails to load a message is written to the log and -- monospaced fallback metrics are used. loadAfmFontMetrics :: FilePath -> [FontDef] -> IO FontLoadResult -- | loadAfmFont1 : path_to_afm_fonts * font_def -> IO -- FontLoadResult -- -- Load a single AFM font. -- -- Note - if the font fails to load a message is written to the log and -- monospaced fallback metrics are used. loadAfmFont1 :: FilePath -> FontDef -> IO FontLoadResult -- | Top-level GhostScript font loader. -- -- Use this module to build a font loader if you want to work with -- GhostScript, but find the simpleFontLoader in -- Wumpus.Basic.System.FontLoader too inflexible. module Wumpus.Basic.System.FontLoader.GSTopLevel -- | loadGSFontMetrics : path_to_gs_fonts * [font_name] -> -- IO FontLoadResult -- -- Load the supplied list of fonts. -- -- Note - if a font fails to load a message is written to the log and -- monospaced fallback metrics are used. loadGSFontMetrics :: FilePath -> [FontDef] -> IO FontLoadResult -- | loadGSFont1 : path_to_gs_fonts * font_name -> IO -- FontLoadResult -- -- Load a single GhostScript font. -- -- Note - if the font fails to load a message is written to the log and -- monospaced fallback metrics are used. loadGSFont1 :: FilePath -> FontDef -> IO FontLoadResult -- | Top level module for font loading... module Wumpus.Basic.System.FontLoader -- | A FontLoader is an action from a list of fonts to a -- FontLoadResult returned in IO. -- -- Fonts are supplied in a list of Either FontDef FontFamily, -- this is a little cumbersome but it allows the loader to load -- individual fonts and / or a whole families with a single API call. type FontLoader = [Either FontDef FontFamily] -> IO FontLoadResult afmLoaderByEnv :: IO (Maybe FontLoader) gsLoaderByEnv :: IO (Maybe FontLoader) -- | Tries to find the GhostScript metrics first... -- -- Runs the IO action on the loader if it finds one. -- -- Either of one of the environment variables -- WUMPUS_AFM_FONT_DIR or WUMPUS_GS_FONT_DIR must be -- defined and point to their respective directory. simpleFontLoader :: (FontLoader -> IO a) -> IO (Maybe a) default_font_loader_help :: String