-- 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 (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.15.0 to v0.16.0: -- -- -- -- v0.14.0 to v0.15.0: -- -- @package wumpus-basic @version 0.16.0 -- | Version number module Wumpus.Basic.VersionNumber -- | Version number -- -- 
--   (0,16,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 (ViewR a) instance Show a => Show (ViewR a) instance Eq a => Eq (ViewL a) instance Show a => Show (ViewL a) instance Eq a => Eq (JoinList 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) -- | Formatting combinators - pretty printers without the fitting. -- -- Note - indentation support is very limited. Generally one should use a -- proper pretty printing library. module Wumpus.Basic.Utils.FormatCombinators -- | Doc is a Join List ... data Doc type DocS = Doc -> Doc class Format a format :: Format a => a -> Doc -- | Create an empty, zero length document. empty :: Doc -- | Create a document from a ShowS function. showsDoc :: ShowS -> Doc -- | Horizontally concatenate two documents with no space between them. (<>) :: Doc -> Doc -> Doc -- | Horizontally concatenate two documents with a single space between -- them. (<+>) :: Doc -> Doc -> Doc -- | Vertical concatenate two documents with a line break. vconcat :: Doc -> Doc -> Doc separate :: Doc -> [Doc] -> Doc -- | Horizontally concatenate a list of documents with (<>). hcat :: [Doc] -> Doc -- | Horizontally concatenate a list of documents with -- (<+>). hsep :: [Doc] -> Doc -- | Vertically concatenate a list of documents, with a line break between -- each doc. vcat :: [Doc] -> Doc -- | Create a document from a literal string. -- -- The string should not contain newlines (though this is not enforced). text :: String -> Doc -- | Create a document from a literal character. -- -- The char should not be a tab or newline. char :: Char -> Doc -- | Show the Int as a Doc. -- -- 
--   int  = text . show
--
int :: Int -> Doc -- | Show the Integer as a Doc. integer :: Integer -> Doc -- | Show an "integral value" as a Doc via fromIntegral. integral :: Integral a => a -> Doc -- | Show the Float as a Doc. float :: Double -> Doc -- | Show the Double as a Doc. double :: Double -> Doc -- | Show the Int as hexadecimal, padding up to 4 digits if necessary. -- -- No trucation occurs if the value has more than 4 digits. hex4 :: Int -> Doc -- | Create a Doc containing a single space character. space :: Doc -- | Create a Doc containing a comma, ",". comma :: Doc -- | Create a Doc containing a semi colon, ";". semicolon :: Doc -- | Create a Doc containing newline, "\n". line :: Doc -- | Fill a doc to the supplied length, padding the right-hand side with -- spaces. -- -- Note - this function is expensive - it unrolls the functional -- representation of the String. -- -- Also it should only be used for single line Doc's. fill :: Int -> Doc -> Doc -- | String version of fill. -- -- This is more efficient than fill as the input is a string so -- its length is more accesible. -- -- Padding is the space character appended to the right. fillStringR :: Int -> String -> Doc -- | Left-padding version of fillStringR. fillStringL :: Int -> String -> Doc -- | Punctuate the Doc list with the separator, producing a Doc. punctuate :: Doc -> [Doc] -> Doc -- | Enclose the final Doc within the first two. -- -- There are no spaces between the documents: -- -- 
--   enclose l r d = l <> d <> r
--
enclose :: Doc -> Doc -> Doc -> Doc -- | Enclose the Doc within single quotes. squotes :: Doc -> Doc -- | Enclose the Doc within double quotes. dquotes :: Doc -> Doc -- | Enclose the Doc within parens (). parens :: Doc -> Doc -- | Enclose the Doc within square brackets []. brackets :: Doc -> Doc -- | Enclose the Doc within curly braces {}. braces :: Doc -> Doc -- | Enclose the Doc within angle brackets <>. angles :: Doc -> Doc -- | Create a Doc containing a left paren, '('. lparen :: Doc -- | Create a Doc containing a right paren, ')'. rparen :: Doc -- | Create a Doc containing a left square bracket, '['. lbracket :: Doc -- | Create a Doc containing a right square bracket, ']'. rbracket :: Doc -- | Create a Doc containing a left curly brace, '{'. lbrace :: Doc -- | Create a Doc containing a right curly brace, '}'. rbrace :: Doc -- | Create a Doc containing a left angle bracket, '<'. langle :: Doc -- | Create a Doc containing a right angle bracket, '>'. rangle :: Doc -- | Comma separate the list of documents and enclose in square brackets. list :: [Doc] -> Doc -- | Comma separate the list of documents and enclose in parens. tupled :: [Doc] -> Doc -- | Separate the list with a semicolon and enclose in curly braces. semiBraces :: [Doc] -> Doc -- | Horizontally indent a Doc. -- -- Note - this space-prefixes the Doc on the current line. It does -- not indent subsequent lines if the Doc spans multiple lines. indent :: Int -> Doc -> Doc -- | Write a Doc to file. writeDoc :: FilePath -> Doc -> IO () instance Monoid Doc instance Show Doc -- | 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 -- | GhostScript Font map. -- -- GhostScript aliases the Core 14 PostScript fonts to fonts it -- can freely distribute. This module provides aliases to Wumpus so the -- font loader can find the equivalent GhostScript files to the Core 14 -- set. -- -- The data in this file matches GhostScript 8.63. Other versions of -- GhostScript may need different aliases. module Wumpus.Basic.System.FontLoader.Base.GSFontMap -- | GhostScript version that the aliases were derived from. -- -- ghostscript_version :: String ghostscript_version = gs8.54 -- -- A map from standard Adode PostScript font name to the -- equivalent GhostScript font and AFM file name. -- -- It is expected that all GhostScript AFM files will be located in the -- same directory. data GSFontMap GSFontMap :: String -> Map String (String, FilePath) -> GSFontMap ghostscript_version :: GSFontMap -> String ghostscript_fontmap :: GSFontMap -> Map String (String, FilePath) -- | Get the .afm metrics file. -- -- Note this return only the file name and not the path to it. The full -- path must be resolved in client code. gsMetricsFile :: GSFontMap -> String -> Maybe FilePath -- | Get the GhostScript font name alias. gsFontAlias :: GSFontMap -> String -> Maybe String -- | Get the GhostScript version number that the FontMap represents. gsVersionNumber :: GSFontMap -> String -- | Map from PostScript font name to the corresponding GhostScript name -- and file. -- -- Naming is correct for GhostSCript version 8.54. ghostscript_fontmap_8_54 :: GSFontMap -- | 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] fromListH :: [a] -> H a -- | Scaling in X and Y -- -- ** WARNING ** - half baked. module Wumpus.Basic.Kernel.Base.ScalingContext -- | ScalingContext is a dictionary of two functions for scaling in X and -- Y. data ScalingContext ux uy u ScalingContext :: (ux -> u) -> (uy -> u) -> ScalingContext ux uy u scale_in_x :: ScalingContext ux uy u -> ux -> u scale_in_y :: ScalingContext ux uy u -> uy -> u scaleX :: ScalingContext ux uy u -> ux -> u scaleY :: ScalingContext ux uy u -> uy -> u scalePt :: ScalingContext ux uy u -> ux -> uy -> Point2 u scaleVec :: ScalingContext ux uy u -> ux -> uy -> Vec2 u unitX :: Num ux => ScalingContext ux uy u -> u unitY :: Num uy => ScalingContext ux uy u -> u -- | Build a ScalingContext where both X and Y are scaled by the same -- uniform step. -- -- The dimensions (types) of the ScalingContext are unified - the output -- type and the input types are all the same. uniformScaling :: Num u => u -> ScalingContext u u u -- | Build a ScalingContext for scaling Int coordinates. -- -- The scaling factors in X and Y can be different sizes. coordinateScaling :: Num u => u -> u -> ScalingContext Int Int u -- | Data types representing glyph metrics loaded from font files. module Wumpus.Basic.Kernel.Base.GlyphMetrics type FontName = String -- | A Unicode code-point. type CodePoint = Int -- | A lookup from code point to width vector. -- -- 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 CharWidthTable u = CodePoint -> Vec2 u -- | Operations on the metrics set of a font. -- -- The is the internal representation used by Wumpus-Basic after parsing -- the font file. data MetricsOps MetricsOps :: (forall u. FromPtSize u => PtSize -> BoundingBox u) -> (forall u. FromPtSize u => PtSize -> CharWidthTable u) -> (forall u. FromPtSize u => PtSize -> u) -> (forall u. FromPtSize u => PtSize -> u) -> MetricsOps get_bounding_box :: MetricsOps -> forall u. FromPtSize u => PtSize -> BoundingBox u get_cw_table :: MetricsOps -> forall u. FromPtSize u => PtSize -> CharWidthTable u get_cap_height :: MetricsOps -> forall u. FromPtSize u => PtSize -> u get_descender :: MetricsOps -> forall u. FromPtSize u => PtSize -> u -- | MetricsOps for a particular named font. data FontMetricsOps FontMetricsOps :: FontName -> MetricsOps -> FontMetricsOps -- | A map between a font name and MetricsOps. data GlyphMetrics emptyGlyphMetrics :: GlyphMetrics lookupFont :: FontName -> GlyphMetrics -> Maybe MetricsOps insertFont :: FontMetricsOps -> GlyphMetrics -> GlyphMetrics -- | This ignores the Char code lookup and just returns the default advance -- vector. monospace_metrics :: MetricsOps instance Monoid GlyphMetrics -- | Datatypes module Wumpus.Basic.System.FontLoader.Base.Datatypes -- | Wrapped Double representing 1/1000 of the scale factor (Point size) of -- a font. AFM files encode all measurements as these units. data AfmUnit -- | Compute the size of a measurement in Afm units scaled by the point -- size of the font. afmValue :: FromPtSize u => AfmUnit -> PtSize -> u afmUnitScale :: AfmUnit -> PtSize -- | 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 -> [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_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 -> Vec2 cu -> MonospaceDefaults cu default_letter_bbox :: MonospaceDefaults cu -> BoundingBox cu default_cap_height :: MonospaceDefaults cu -> cu default_descender :: 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 -> 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 -- | Build a MetricsOps function table, from a character unit scaling -- function and FontProps read from a file. buildMetricsOps :: (cu -> PtSize) -> FontProps cu -> MetricsOps instance Eq cu => Eq (MonospaceDefaults cu) instance Show cu => Show (MonospaceDefaults cu) instance Eq AfmGlyphMetrics instance Show AfmGlyphMetrics instance Show AfmFile instance Eq AfmUnit instance Ord AfmUnit instance Num AfmUnit instance Floating AfmUnit instance Fractional AfmUnit instance Real AfmUnit instance RealFrac AfmUnit instance RealFloat AfmUnit instance Show AfmUnit -- | Font load monad handling IO (file system access), failure and logging. module Wumpus.Basic.System.FontLoader.Base.FontLoadMonad type FontLoadErr = String data FontLoadIO a runFontLoadIO :: FontLoadIO a -> IO (Either FontLoadErr a, [String]) evalFontLoadIO :: FontLoadIO a -> IO (Either FontLoadErr a) loadError :: FontLoadErr -> FontLoadIO a logLoadMsg :: String -> FontLoadIO () -- | aka liftIO promoteIO :: IO a -> FontLoadIO a promoteEither :: Either FontLoadErr 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 instance Monoid FontLoadLog -- | Common parsers for AFM files. module Wumpus.Basic.System.FontLoader.Base.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.Base.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.Base.AfmV2Parser afmV2Parser :: CharParser AfmFile -- | 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 - round_corner_factor is only accounted for by some -- graphic objects (certain Path objects and Shapes in Wumpus-Drawing for -- instance). There many be many objects that ignore it and are drawn -- only with angular corners. -- -- Also note - in contrast to most other drawing objects in Wumpus, none -- of the measurement values are parameteric - usually notated with the -- type variable u in Wumpus. This is so Wumpus can -- (potentially) support different units e.g. centimeters rather than -- just Doubles (represening printers points), though adding support for -- other units has a very low priority. data DrawingContext DrawingContext :: GlyphMetrics -> MetricsOps -> StrokeAttr -> FontAttr -> RGBi -> RGBi -> Double -> Double -> TextMargin -> DrawingContext glyph_tables :: DrawingContext -> GlyphMetrics fallback_metrics :: DrawingContext -> MetricsOps stroke_props :: DrawingContext -> StrokeAttr font_props :: DrawingContext -> FontAttr stroke_colour :: DrawingContext -> RGBi fill_colour :: DrawingContext -> RGBi line_spacing_factor :: DrawingContext -> Double round_corner_factor :: DrawingContext -> Double text_margin :: DrawingContext -> TextMargin -- | Type synonym for DrawingContext update functions. type DrawingContextF = DrawingContext -> DrawingContext -- | The unit of Margin is always Double representing Points, e.g. 1.0 is 1 -- Point. Margins are not scaled relative to the current font size. -- -- The default value is 2 point. data TextMargin TextMargin :: !Double -> !Double -> TextMargin text_margin_x :: TextMargin -> !Double text_margin_y :: TextMargin -> !Double standardContext :: FontSize -> DrawingContext metricsContext :: FontSize -> GlyphMetrics -> DrawingContext default_drawing_context :: DrawingContext class (Applicative m, Monad m) => DrawingCtxM m :: (* -> *) askDC :: DrawingCtxM m => m DrawingContext localize :: DrawingCtxM m => (DrawingContext -> DrawingContext) -> m a -> m a -- | Project a value out of a context. asksDC :: DrawingCtxM m => (DrawingContext -> a) -> m a withFontMetrics :: (MetricsOps -> PtSize -> 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 textAttr :: DrawingCtxM m => m (RGBi, FontAttr) -- | Because textAttr is so commonly used here is a functional -- version that avoids tupling. withTextAttr :: DrawingCtxM m => (RGBi -> FontAttr -> a) -> m a strokeAttr :: DrawingCtxM m => m (RGBi, StrokeAttr) withStrokeAttr :: DrawingCtxM m => (RGBi -> StrokeAttr -> a) -> m a fillAttr :: DrawingCtxM m => m RGBi withFillAttr :: DrawingCtxM m => (RGBi -> a) -> m a borderedAttr :: DrawingCtxM m => m (RGBi, StrokeAttr, RGBi) withBorderedAttr :: DrawingCtxM m => (RGBi -> StrokeAttr -> RGBi -> a) -> m a -- | Size of the round corner factor. getRoundCornerSize :: (DrawingCtxM m, Fractional u, FromPtSize u) => m u -- | Get the (x,y) margin around text. -- -- Note - not all text operations in Wumpus are drawn with text margin. getTextMargin :: (DrawingCtxM m, Fractional u, FromPtSize u) => m (u, u) getLineWidth :: DrawingCtxM m => m Double getFontAttr :: DrawingCtxM m => m FontAttr getFontSize :: DrawingCtxM m => m Int getFontFace :: DrawingCtxM m => m FontFace -- | The mark height is the height of a lowercase letter in the -- current font. -- -- Arrowheads, dots etc. should generally be drawn at the mark height. markHeight :: (DrawingCtxM m, FromPtSize u) => m u markHalfHeight :: (DrawingCtxM m, Fractional u, FromPtSize u) => m u -- | Vertical distance between baselines of consecutive text lines. baselineSpacing :: (DrawingCtxM m, Fractional 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 :: (FromPtSize u, DrawingCtxM m) => m (BoundingBox u) glyphCapHeight :: (FromPtSize u, DrawingCtxM m) => m u -- | Note - descender is expected to be negative. glyphDescender :: (FromPtSize u, DrawingCtxM m) => m u -- | This is the distance from cap_height to descender. glyphVerticalSpan :: (FromPtSize u, DrawingCtxM m) => m u cwLookupTable :: (FromPtSize u, DrawingCtxM m) => m (CharWidthTable u) monoFontPointSize :: (DrawingCtxM m, FromPtSize u) => m u monoCharWidth :: (DrawingCtxM m, FromPtSize u) => m u monoTextWidth :: (DrawingCtxM m, FromPtSize u) => Int -> m u monoTextLength :: (DrawingCtxM m, FromPtSize u) => String -> m u monoCapHeight :: (DrawingCtxM m, FromPtSize u) => m u -- | Height of a lower case 'x' in Courier. -- -- 'x' has no ascenders or descenders. monoLowerxHeight :: (DrawingCtxM m, FromPtSize u) => m u monoDescenderDepth :: (DrawingCtxM m, FromPtSize u) => m u monoAscenderHeight :: (DrawingCtxM m, FromPtSize u) => m u -- | Query the dimensions of the text using the current font size but using -- metrics derived from Courier. -- -- Note - the width will generally be a over-estimate for non-monospaced -- fonts. monoTextDimensions :: (DrawingCtxM m, Num u, Ord u, FromPtSize u) => String -> m (u, u) -- | The heigth of n lines of text, which is n lines + n-1 -- line spacers monoMultiLineHeight :: (DrawingCtxM m, Fractional u, FromPtSize u) => Int -> m u -- | The default padding is half of the char width. monoDefaultPadding :: (DrawingCtxM m, Fractional u, FromPtSize u) => m u -- | Vector from baseline left to center monoVecToCenter :: (DrawingCtxM m, Fractional u, Ord u, FromPtSize u) => String -> m (Vec2 u) -- | Customize drawing attributes -- -- ** WARNING ** - this module needs systematic naming schemes both for -- update functions (primaryColour, ...) and for synthesized selectors -- (e.g. lowerxHeight). The current names will change. module Wumpus.Basic.Kernel.Base.UpdateDC roundCornerFactor :: Double -> DrawingContextF -- | textMargin : xsep * ysep -> DrawingContextF textMargin :: Double -> Double -> DrawingContextF lineWidth :: Double -> DrawingContextF -- | Set the line width to a thick. -- -- Note this context update is oblivious - operationally the line -- width is set to exactly 2.0. thick :: DrawingContextF ultrathick :: DrawingContextF thin :: DrawingContextF capButt :: DrawingContextF capRound :: DrawingContextF capSquare :: DrawingContextF joinMiter :: DrawingContextF joinRound :: DrawingContextF joinBevel :: DrawingContextF dashPattern :: DashPattern -> DrawingContextF unit_dash_pattern :: DashPattern phase :: Int -> DashPattern -> DashPattern dphase :: Int -> DashPattern -> DashPattern doublegaps :: DashPattern -> DashPattern doubledashes :: DashPattern -> DashPattern fontAttr :: FontFace -> Int -> DrawingContextF fontSize :: Int -> DrawingContextF fontFace :: FontFace -> DrawingContextF scalesize :: Ratio Int -> DrawingContextF -- | Set the font size to double the current size, note the font size also -- controls the size of dots, arrowsheads etc. doublesize :: DrawingContextF -- | Set the font size to half the current size, note the font size also -- controls the size of dots, arrowsheads etc. -- -- As fontsize is an integer this is not exact - half size of 15pt type -- is 7pt. halfsize :: DrawingContextF swapColours :: DrawingContextF bothStrokeColour :: DrawingContextF bothFillColour :: DrawingContextF strokeColour :: RGBi -> DrawingContextF fillColour :: RGBi -> DrawingContextF -- | The elementary base types and classes. module Wumpus.Basic.Kernel.Base.BaseDefs -- | A Semigroup class. -- -- The perhaps unusual name is the TeX name for the circled plus glyph. -- It would be nice if there was a semigroup class in the Haskell Base -- libraries... class OPlus t oplus :: OPlus t => t -> t -> t oconcat :: OPlus t => t -> [t] -> t -- | A Bifunctor class. -- -- Again, it would be nice if there was a Bifunctor class in the Haskell -- Base libraries... class Bimap f bimap :: Bimap f => (a -> p) -> (b -> q) -> f a b -> f p q bimapL :: Bimap f => (a -> p) -> f a b -> f p b bimapR :: Bimap f => (b -> q) -> f a b -> f a q replaceL :: Bimap f => p -> f a b -> f p b replaceR :: Bimap f => q -> f a b -> f a q -- | Horizontal alignment - align to the top, center or bottom. data HAlign HTop :: HAlign HCenter :: HAlign HBottom :: HAlign -- | Vertical alignment - align to the left, center or bottom. data VAlign VLeft :: VAlign VCenter :: VAlign VRight :: VAlign -- | 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 -- | 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 -- | DUnit is always for fully saturated type constructors, so (seemingly) -- an equivalent type family is needed for monads. -- | A monad that supplies points, e.g. a turtle monad. -- -- ** WARNING ** - the idea behind this class is somewhat half-baked. It -- may be revised or even dropped in subsequent versions of Wumpus-Basic. class Monad m => PointSupplyM m :: (* -> *) position :: (PointSupplyM m, (MonUnit m) ~ u) => m (Point2 u) instance Enum Cardinal instance Eq Cardinal instance Ord Cardinal instance Show Cardinal instance Enum VAlign instance Eq VAlign instance Ord VAlign instance Show VAlign instance Enum HAlign instance Eq HAlign instance Ord HAlign instance Show HAlign instance Bimap Either instance Bimap (,) instance Num u => OPlus (Vec2 u) instance OPlus a => OPlus (r -> a) instance (OPlus a, OPlus b, OPlus c, OPlus d) => OPlus (a, b, c, d) instance (OPlus a, OPlus b, OPlus c) => OPlus (a, b, c) instance (OPlus a, OPlus b) => OPlus (a, b) instance OPlus (Primitive u) instance Ord u => OPlus (BoundingBox u) instance OPlus (UNil u) instance OPlus () -- | Function types operating over the DrawingContext as a static -- argument. module Wumpus.Basic.Kernel.Base.ContextFun -- | Most drawing operations in Wumpus-Basic have an implicit graphics -- state the DrawingContext, so the most primitive building -- block is a function from the DrawingContext to some polymorphic -- answer. -- -- This functional type is represented concretely as the initials -- CF for contextual function. -- -- 
--   CF :: DrawingContext -> a 
--
data CF a -- | Variation of CF with one parametric static argument. -- -- The static argument is commonly a point representing the start point / -- origin of a drawing. -- -- 
--   CF1 :: DrawingContext -> r1 -> a 
--
data CF1 r1 a -- | Variation of CF with two parametric static arguments. -- -- The first argument is commonly a point representing the start point / -- origin of a drawing. The second argument might typically be the angle -- of displacement (for drawing arrowheads) or an end point (for drawing -- connectors between two points). -- -- 
--   CF2 :: DrawingContext -> r1 -> r2 -> a 
--
data CF2 r1 r2 a -- | Type specialized verison of CF1 where the static -- argument is the start point. -- -- 
--   LocCF :: DrawingContext -> Point2 u -> a 
--
type LocCF u a = CF1 (Point2 u) a -- | Type specialized verison of CF2 where the static -- arguments are the start point and the angle of -- displacement. -- -- 
--   LocThetaCF :: DrawingContext -> Point2 u -> Radian -> a 
--
type LocThetaCF u a = CF2 (Point2 u) Radian a -- | Type specialized verison of CF2 where the static -- arguments are the start point and the end point. -- -- 
--   ConnectorCF :: DrawingContext -> Point2 u -> Point2 u -> a 
--
type ConnectorCF u a = CF2 (Point2 u) (Point2 u) a -- | Alias of LocCF where the unit type is specialized to -- Double. type DLocCF a = LocCF Double a -- | Alias of LocThetaCF where the unit type is specialized to -- Double. type DLocThetaCF a = LocThetaCF Double a -- | Alias of ConnectorCF where the unit type is specialized to -- Double. type DConnectorCF a = ConnectorCF Double a -- | Run a CF (context function) with the supplied -- DrawingContext. runCF :: DrawingContext -> CF a -> a -- | Run a CF1 (context function) with the supplied -- DrawingContext and static argument. runCF1 :: DrawingContext -> r1 -> CF1 r1 a -> a -- | Run a CF1 (context function) with the supplied -- DrawingContext and two static arguments. runCF2 :: DrawingContext -> r1 -> r2 -> CF2 r1 r2 a -> a -- | Lift a zero-arity context function CF to an arity one context -- function CF1. lift0R1 :: CF a -> CF1 r1 a -- | Lift a zero-arity context function CF to an arity two context -- function CF2. lift0R2 :: CF a -> CF2 r1 r2 a -- | Lift an arity one context function CF1 to an arity two context -- function CF2. lift1R2 :: CF1 r1 a -> CF2 r1 r2 a -- | Promote a function from one argument to a Context Function to -- an arity one Context Function. -- -- The type signature is as explanatory as a description: -- -- 
--   promoteR1 :: (r1 -> CF a) -> CF1 r1 a
--
promoteR1 :: (r1 -> CF a) -> CF1 r1 a -- | Promote a function from two arguments to a Context Function -- to an arity two Context Function. -- -- The type signature is as explanatory as a description: -- -- 
--   promoteR2 :: (r1 -> r2 -> CF a) -> CF2 r1 r2 a
--
promoteR2 :: (r1 -> r2 -> CF a) -> CF2 r1 r2 a -- | Apply an arity-one Context Function to a single argument, downcasting -- it by one level, making an arity-zero Context function. -- -- The type signature is as explanatory as a description: -- -- 
--   apply1R1 :: CF1 r1 a -> r1 -> CF a
--
apply1R1 :: CF1 r1 a -> r1 -> CF a -- | Apply an arity-two Context Function to two arguments, downcasting it -- by two levels, making an arity-zero Context function. -- -- The type signature is as explanatory as a description: -- -- 
--   apply2R2 :: CF2 r1 r2 a -> r1 -> r2 -> CF a
--
apply2R2 :: CF2 r1 r2 a -> r1 -> r2 -> CF a -- | Apply an arity-two Context Function to one argument, downcasting it by -- one level, making an arity-one Context function. -- -- The type signature is as explanatory as a description: -- -- 
--   apply1R2 :: CF2 r1 r2 a -> r2 -> CF1 r1 a
--
apply1R2 :: CF2 r1 r2 a -> r2 -> CF1 r1 a -- | Extract the drawing context from a CtxFun. -- -- 
--   (ctx -> ctx)
--
drawingCtx :: CF DrawingContext -- | Apply the projection function to the drawing context. -- -- 
--   (ctx -> a) -> (ctx -> a)
--
queryCtx :: (DrawingContext -> a) -> CF a -- | Extract the drawing context from a LocCF. -- -- 
--   (ctx -> pt -> ctx)
--
locCtx :: LocCF u DrawingContext -- | Extract the start point from a LocCF. -- -- 
--   (ctx -> pt -> pt)
--
locPoint :: LocCF u (Point2 u) -- | Extract the drawing context from a LocThetaCF. -- -- 
--   (ctx -> pt -> ang -> ctx)
--
locThetaCtx :: LocThetaCF u DrawingContext -- | Extract the start point from a LocThetaCF. -- -- 
--   (ctx -> pt -> ang -> pt)
--
locThetaPoint :: LocThetaCF u (Point2 u) -- | Extract the angle from a LocThetaCF. -- -- 
--   (ctx -> pt -> ang -> ang)
--
locThetaAng :: LocThetaCF u Radian -- | Extract the drawing context from a ConnectorCF. -- -- 
--   (ctx -> pt1 -> pt2 -> ctx)
--
connCtx :: ConnectorCF u DrawingContext -- | Extract the start point from a ConnectorCF. -- -- 
--   (ctx -> pt1 -> pt2 -> pt1)
--
connStart :: ConnectorCF u (Point2 u) -- | Extract the end point from a ConnectorCF. -- -- 
--   (ctx -> pt1 -> pt2 -> pt2)
--
connEnd :: ConnectorCF u (Point2 u) -- | Downcast a LocCF function by applying it to the supplied point, -- making an arity-zero Context Function. -- -- Remember a LocCF function is a CF1 context function -- where the static argument is specialized to a start point. at :: LocCF u a -> Point2 u -> CF a -- | Downcast a LocThetaCF function by applying it to the supplied -- angle, making an arity-one Context Function (a LocCF). rot :: LocThetaCF u a -> Radian -> LocCF u a -- | Downcast a LocThetaCF function by applying it to the supplied -- point and angle, making an arity-zero Context Function (a CF). atRot :: LocThetaCF u a -> Point2 u -> Radian -> CF a -- | Downcast a ConnectorCF function by applying it to the start and -- end point, making an arity-zero Context Function (a CF). connect :: ConnectorCF u a -> Point2 u -> Point2 u -> CF a -- | Chaining combinator - the answer of the first Context -- Function is feed to the second Context Function. -- -- This contrasts with the usual idiom in Wumpus-Basic where -- composite graphics are built by applying both functions to the same -- initial static argument. -- -- Desciption: -- -- Evaluate the first Context Function with the drawing context and the -- initial state st0. The result of the evaluation is a -- new state st1 and and answer a1. -- -- Evaluate the second Context Function with the drawing context and the -- new state st1, producing a new state s2 and an -- answer a2. -- -- Return the result of combining the answers with op :: (ans -> -- ans -> ans) and the second state s2. -- -- 
--   (ctx -> s1 -> (w,s1)) -> (ctx -> s1 -> (w,s1)) -> (ctx -> s1 -> (w,s1))
--
-- -- This models chaining start points together, which is the model -- PostScript uses for text output when successively calling the -- show operator. chain1 :: OPlus w => CF1 s1 (s1, w) -> CF1 s1 (s1, w) -> CF1 s1 (s1, w) instance DrawingCtxM (CF2 r1 r2) instance DrawingCtxM (CF1 r1) instance DrawingCtxM CF instance Monad (CF2 r1 r2) instance Monad (CF1 r1) instance Monad CF instance Applicative (CF2 r1 r2) instance Applicative (CF1 r1) instance Applicative CF instance Functor (CF2 r1 r2) instance Functor (CF1 r1) instance Functor CF instance Monoid a => Monoid (CF2 r1 r2 a) instance Monoid a => Monoid (CF1 r1 a) instance Monoid a => Monoid (CF a) instance OPlus a => OPlus (CF2 r1 r2 a) instance OPlus a => OPlus (CF1 r1 a) instance OPlus a => OPlus (CF a) -- | 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 -- | ThetaDisplace is a type representing functions from Radian -- to Radian. -- -- 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 ThetaDisplace = Radian -> Radian -- | 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 -> PointDisplace u -- | Move the start-point of a LocCF with the supplied displacement -- function. moveStart :: PointDisplace u -> LocCF u a -> LocCF u a -- | Move the start-point of a LocThetaCF with the supplied -- displacement function. moveStartTheta :: ThetaPointDisplace u -> LocThetaCF u a -> LocThetaCF u a -- | Move the start-point of a LocThetaCF with the supplied -- displacement function. moveStartThetaPoint :: PointDisplace u -> LocThetaCF u a -> LocThetaCF u a -- | Change the inclination of a LocThetaCF with the supplied -- displacement function. moveStartThetaAngle :: ThetaDisplace -> LocThetaCF u a -> LocThetaCF u a -- | displace : x -> y -> PointDisplace -- -- Build a combinator to move Points by the supplied x -- and y distances. displace :: Num u => u -> u -> PointDisplace u -- | displaceV : (V2 x y) -> PointDisplace -- -- Version of displace where the displacement is supplied as a -- vector rather than two parameters. displaceVec :: Num u => Vec2 u -> PointDisplace u -- | displaceH : x -> PointDisplace -- -- Build a combinator to move Points by horizontally the -- supplied x distance. displaceH :: Num u => u -> PointDisplace u -- | displaceV : y -> PointDisplace -- -- Build a combinator to move Points vertically by the supplied -- y distance. displaceV :: Num u => u -> PointDisplace u northwards :: Num u => u -> PointDisplace u southwards :: Num u => u -> PointDisplace u eastwards :: Num u => u -> PointDisplace u westwards :: Num u => u -> PointDisplace u northeastwards :: Floating u => u -> PointDisplace u northwestwards :: Floating u => u -> PointDisplace u southeastwards :: Floating u => u -> PointDisplace u southwestwards :: Floating u => u -> PointDisplace u -- | displaceParallel : dist -> ThetaPointDisplace -- -- Build a combinator to move Points in parallel to the -- direction of the implicit angle by the supplied distance -- dist. displaceParallel :: Floating u => u -> ThetaPointDisplace u -- | displaceParallel : dist -> ThetaPointDisplace -- -- Build a combinator to move Points perpendicular to the -- inclnation of the implicit angle by the supplied distance -- dist. displacePerpendicular :: Floating u => u -> ThetaPointDisplace u -- | displaceOrtho : 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. displaceOrtho :: Floating u => Vec2 u -> ThetaPointDisplace u thetaNorthwards :: Floating u => u -> ThetaPointDisplace u thetaSouthwards :: Floating u => u -> ThetaPointDisplace u thetaEastwards :: Floating u => u -> ThetaPointDisplace u thetaWestwards :: Floating u => u -> ThetaPointDisplace u thetaNortheastwards :: Floating u => u -> ThetaPointDisplace u thetaNorthwestwards :: Floating u => u -> ThetaPointDisplace u thetaSoutheastwards :: Floating u => u -> ThetaPointDisplace u thetaSouthwestwards :: Floating u => u -> ThetaPointDisplace u -- | Two warpped versions of the Primitive type from Wumpus-Core. module Wumpus.Basic.Kernel.Base.WrappedPrimitive -- | Graphics objects, even simple ones (line, arrow, dot) might need more -- than one primitive (path or text label) for their construction. Hence, -- the primary representation that all the others are built upon must -- support concatenation of primitives. -- -- Wumpus-Core has a type Picture - made from one or more Primitives - -- but Pictures include support for affine frames. For drawing many -- simple graphics (dots, connector lines...) that do not need individual -- affine transformations this is a penalty. A list of Primitives is -- therefore more suitable representation, and a Hughes list which -- supports efficient concatenation is wise. data HPrim u hprimToList :: HPrim u -> [Primitive u] singleH :: Primitive u -> HPrim u -- | Collect elementary graphics as part of a larger drawing. -- -- TraceM works much like a writer monad. class TraceM m :: (* -> *) trace :: (TraceM m, (MonUnit m) ~ u) => HPrim u -> m () data PrimGraphic u getPrimGraphic :: PrimGraphic u -> Primitive u primGraphic :: Primitive u -> PrimGraphic u metamorphPrim :: (Primitive u -> Primitive u) -> PrimGraphic u -> PrimGraphic u collectH :: PrimGraphic u -> HPrim u instance Eq u => Eq (PrimGraphic u) instance Show u => Show (PrimGraphic u) instance Num u => Translate (PrimGraphic u) instance Num u => Scale (PrimGraphic u) instance (Real u, Floating u) => RotateAbout (PrimGraphic u) instance (Real u, Floating u) => Rotate (PrimGraphic u) instance OPlus (PrimGraphic u) instance Monoid (HPrim u) -- | Aliases for ContextFun types. module Wumpus.Basic.Kernel.Objects.BaseObjects -- | A query on the DrawingContext. -- -- Alias for CF. type DrawingInfo a = CF a -- | A query on the DrawingContext respective to the supplied point. -- -- Alias for LocCF. type LocDrawingInfo u a = LocCF u a -- | A query on the DrawingContext respective to the supplied point and -- angle. -- -- Alias for LocCF. type LocThetaDrawingInfo u a = LocThetaCF u a -- | An Image always returns a pair of some polymorphic answer a -- and a PrimGraphic. -- -- Note a PrimGraphic cannot be empty. type ImageAns u a = (a, PrimGraphic u) type GraphicAns u = ImageAns u (UNil u) -- | Draw a PrimGraphic repsective to the DrawingContext and -- return some answer a. type Image u a = CF (ImageAns u a) -- | Draw a PrimGraphic respective to the DrawingContext and the -- supplied point, return some answer a. type LocImage u a = LocCF u (ImageAns u a) -- | Draw a PrimGraphic respective to the DrawingContext and the -- supplied point and angle. type LocThetaImage u a = LocThetaCF u (ImageAns u a) type DImage a = Image Double a type DLocImage a = LocImage Double a type DLocThetaImage a = LocThetaImage Double a instance (DUnit a ~ u, Num u, Translate a) => Translate (LocImage u a) instance (DUnit a ~ u, Num u, Scale a) => Scale (LocImage u a) instance (DUnit a ~ u, Real u, Floating u, RotateAbout a) => RotateAbout (LocImage u a) instance (DUnit a ~ u, Real u, Floating u, Rotate a) => Rotate (LocImage u a) instance (DUnit a ~ u, Num u, Translate a) => Translate (Image u a) instance (DUnit a ~ u, Num u, Scale a) => Scale (Image u a) instance (DUnit a ~ u, Real u, Floating u, RotateAbout a) => RotateAbout (Image u a) instance (DUnit a ~ u, Real u, Floating u, Rotate a) => Rotate (Image u a) -- | Graphic type - this is largely equivalent to Primitive in Wumpus-Core, -- but drawing attributes are implicitly supplied by the DrawingContext. -- -- API in Wumpus.Core, but here they exploit the implicit -- DrawingContext. module Wumpus.Basic.Kernel.Objects.Graphic -- | Simple drawing - produce a primitive, access the DrawingContext as -- required, e.g for fill colour, stroke colur, line width, etc. type Graphic u = Image u (UNil u) -- | Alias of Graphic where the unit type is specialized to Double. type DGraphic = Graphic Double -- | Originated drawing - produce a primitive respective to the -- supplied start-point, access the DrawingContext as required. type LocGraphic u = LocImage u (UNil u) -- | Alias of LocGraphic where the unit type is specialized to -- Double. type DLocGraphic = LocGraphic Double -- | Originated drawing - produce a primitive respective to the -- supplied start-point, access the DrawingContext as required. type LocThetaGraphic u = LocThetaImage u (UNil u) -- | Alias of LocThetaGraphic where the unit type is specialized to -- Double. type DLocThetaGraphic = LocThetaGraphic Double -- | safeconcat : alternative * [image] -> Image -- -- safeconcat produces a composite Image from a list of -- Image's. If the list is empty the alternative Image -- is used. -- -- This contrasts to oconcat - when used for Image's, -- oconcat has the same type signature as safeconcat -- but oconcat considers its arguments to be an already -- destructured list: -- -- 
--   oconcat (head::Image) (rest::[Image])
--
safeconcat :: OPlus a => Image u a -> [Image u a] -> Image u a -- | Ignore the answer produced by an Image, a LocImage etc. -- -- Use this function to turn an Image into a Graphic, a -- 'LocImage into a LocGraphic. ignoreAns :: Functor f => f (a, b) -> f (UNil u, b) -- | Replace the answer produced by an Image, a LocImage etc. replaceAns :: Functor f => z -> f (a, b) -> f (z, b) -- | Apply the supplied function to the answer produced by an Image, -- a LocImage etc. mapAns :: Functor f => (a -> z) -> f (a, b) -> f (z, b) -- | intoImage : context_function * graphic -> Image -- -- Build an Image from a context function (CF) that -- generates the answer and a Graphic that draws the Image. intoImage :: CF a -> Graphic u -> Image u a -- | intoLocImage : loc_context_function * loc_graphic -> -- LocImage -- -- Loc version of intoImage. -- -- The LocImage is built as a function from an implicit start -- point to the answer. intoLocImage :: LocCF u a -> LocGraphic u -> LocImage u a -- | intoLocThetaImage : loc_theta_cf * loc_theta_graphic -> -- LocThetaImage -- -- LocTheta version of intoImage. -- -- The LocThetaImage is built as a function from an implicit start -- point and angle of inclination to the answer. intoLocThetaImage :: LocThetaCF u a -> LocThetaGraphic u -> LocThetaImage u a -- | emptyLocGraphic : LocGraphic -- -- Build an empty LocGraphic (i.e. a function from Point to -- Graphic). This is a path with a start point but no path segments. -- -- The emptyLocGraphic is treated as a null primitive by -- Wumpus-Core and is not drawn, although it does generate a -- minimum bounding box at the implicit start point. emptyLocGraphic :: Num u => LocGraphic u -- | emptyLocThetaGraphic : LocThetaGraphic -- -- Build an empty LocThetaGraphic (i.e. a function from Point -- and Inclination to Graphic). -- -- The emptyLocThetaGraphic is treated as a null primitive -- by Wumpus-Core and is not drawn, although it does generate a -- minimum bounding box at the implicit start point. emptyLocThetaGraphic :: Num u => LocThetaGraphic u -- | Decorate an Image by superimposing a Graphic. -- -- Note - this function has a very general type signature and supports -- various graphic types: -- -- 
--   decorate :: Image u a -> Graphic u -> Image u a
--   decorate :: LocImage u a -> LocGraphic u -> LocImage u a
--   decorate :: LocThetaImage u a -> LocThetaGraphic u -> LocTheteImage u a
--
decorate :: Monad m => m (ImageAns u a) -> m (ImageAns u zz) -> m (ImageAns u a) -- | Superior decorate - decorate an image by superimposing a -- graphic on top of it. -- -- Note, here the Graphic has access to the result produced by the the -- Image unlike decorate. -- -- Again, this function has a very general type signature and supports -- various graphic types: -- -- 
--   sdecorate :: Image u a -> Graphic u -> Image u a
--   sdecorate :: LocImage u a -> LocGraphic u -> LocImage u a
--   sdecorate :: LocThetaImage u a -> LocThetaGraphic u -> LocTheteImage u a
--
sdecorate :: Monad m => m (ImageAns u a) -> (a -> m (ImageAns u zz)) -> m (ImageAns u a) -- | Anterior decorate - decorate an Image by superimposing it on a -- Graphic. -- -- Note - here the Graphic has access to the result produced by the the -- Image unlike decorate. -- -- Again, this function has a very general type signature and supports -- various graphic types: -- -- 
--   adecorate :: Image u a -> Graphic u -> Image u a
--   adecorate :: LocImage u a -> LocGraphic u -> LocImage u a
--   adecorate :: LocThetaImage u a -> LocThetaGraphic u -> LocTheteImage u a
--
adecorate :: Monad m => m (ImageAns u a) -> (a -> m (ImageAns u zz)) -> m (ImageAns u a) -- | Hyperlink a graphic object. -- -- This function has a very general type signature and supports various -- graphic types: -- -- 
--   hyperlink :: XLink -> Graphic u -> Graphic u
--   hyperlink :: XLink -> Image u a -> Image u a
--   hyperlink :: XLink -> LocImage u a -> LocImage u a
--   hyperlink :: XLink -> LocThetaImage u a -> LocThetaImage u a
--
hyperlink :: Functor m => XLink -> m (ImageAns u a) -> m (ImageAns u a) -- | Extended Graphic object - an AdvanceGraphic is a Graphic twinned with -- and advance vector. module Wumpus.Basic.Kernel.Objects.AdvanceGraphic -- | 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. type AdvGraphic u = LocImage u (Vec2 u) type DAdvGraphic = AdvGraphic Double -- | intoAdvGraphic : loc_context_function * graphic -> -- Image -- -- Build an AdvGraphic from a context function (CF) that -- generates the answer displacement vector and a LocGraphic that -- draws the AdvGraphic. intoAdvGraphic :: LocCF u (Vec2 u) -> LocGraphic u -> AdvGraphic u -- | emptyAdvGraphic : AdvGraphic -- -- Build an empty AdvGraphic. -- -- The emptyAdvGraphic is treated as a null primitive by -- Wumpus-Core and is not drawn, the answer vetor generated is -- the empty vector (V2 0 0). emptyAdvGraphic :: Num u => AdvGraphic u -- | Concatenate the two AdvGraphics. advcat :: Num u => AdvGraphic u -> AdvGraphic u -> AdvGraphic u -- | Concatenate the two AdvGraphics spacing them by the supplied vector. advsep :: Num u => Vec2 u -> AdvGraphic u -> AdvGraphic u -> AdvGraphic u -- | Concatenate the list of AdvGraphic with advcat. advconcat :: Num u => [AdvGraphic u] -> AdvGraphic u -- | Concatenate the list of AdvGraphic with advsep. advspace :: Num u => Vec2 u -> [AdvGraphic u] -> AdvGraphic u -- | Concatenate the list of AdvGraphic with advsep. advpunctuate :: Num u => AdvGraphic u -> [AdvGraphic u] -> AdvGraphic u -- | Render the supplied AdvGraphic, but swap the result advance for the -- supplied vector. This function has behaviour analogue to fill -- in the wl-pprint library. advfill :: Num u => Vec2 u -> AdvGraphic u -> AdvGraphic u -- | Graphic and Image types representing connectors - connectors have two -- implicit points - start and end. module Wumpus.Basic.Kernel.Objects.Connector -- | ConnectorGraphic is a connector drawn between two points contructing a -- Graphic. type ConnectorGraphic u = ConnectorCF u (GraphicAns u) -- | Alias of ConnectorGraphic where the unit type is specialized to -- Double. type DConnectorGraphic = ConnectorGraphic Double -- | ConnectorImage is a connector drawn between two points constructing an -- Image. -- -- Usually the answer type of a ConnectorImage will be a Path (defined in -- Wumpus-Drawing) so the points at midway, atstart -- etc. or the end directions and tangents can be taken on it. type ConnectorImage u a = ConnectorCF u (ImageAns u a) -- | Alias of ConnectorImage where the unit type is specialized to -- Double. type DConnectorImage a = ConnectorImage Double a -- | intoConnectorImage : conn_context_function * conn_graphic -- -> LocImage -- -- Connector version of intoImage. -- -- The ConnectorImage is built as a function from an implicit -- start and end points to the answer. intoConnectorImage :: ConnectorCF u a -> ConnectorGraphic u -> ConnectorImage u a -- | emptyConnectorGraphic : ConnectorGraphic -- -- Build an empty ConnectorGraphic. -- -- The emptyConnectorGraphic is treated as a null primitive -- by Wumpus-Core and is not drawn, although it does generate a -- bounding box around the rectangular hull of the start and end points. emptyConnectorGraphic :: Num u => ConnectorGraphic u -- | Graphic type - this is largely equivalent to Primitive in Wumpus-Core, -- but drawing attributes are implicitly supplied by the DrawingContext. module Wumpus.Basic.Kernel.Objects.DrawingPrimitives -- | locPath : [next_vector] -> (Point2 ~> PrimPath) -- -- -- Create a path LocCF - 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. locPath :: Num u => [Vec2 u] -> LocCF u (PrimPath u) -- | emptyLocPath : (Point ~> PrimPath) -- -- Create an empty path LocCF - 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. emptyLocPath :: Num u => LocCF u (PrimPath u) -- | openStroke : path -> Graphic -- -- This is the analogue to ostroke in Wumpus-core, but -- the drawing properties (colour, line width, etc.) are taken from the -- implicit DrawingContext. openStroke :: Num u => PrimPath u -> Graphic u -- | closedStroke : path -> Graphic -- -- This is the analogue to cstroke in Wumpus-core, but -- the drawing properties (colour, line width, etc.) are taken from the -- implicit DrawingContext. closedStroke :: Num u => PrimPath u -> Graphic u -- | filledPath : path -> Graphic -- -- This is the analogue to fill in Wumpus-core, but the -- fill colour is taken from the implicit DrawingContext. filledPath :: Num u => PrimPath u -> Graphic u -- | borderedPath : path -> Graphic -- -- This is the analogue to fillStroke in Wumpus-core, but -- the drawing properties (fill colour, border colour, line width, etc.) -- are taken from the implicit DrawingContext. borderedPath :: Num u => PrimPath u -> Graphic u -- | textline : 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. textline :: Num u => String -> LocGraphic u -- | rtextline : 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. rtextline :: Num u => String -> LocThetaGraphic u -- | escapedline : 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. escapedline :: Num u => EscapedText -> LocGraphic u -- | rescapedline : 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. rescapedline :: Num 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 :: Num u => [KerningChar 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 :: Num u => [KerningChar u] -> LocGraphic u -- | straightLine : 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. straightLine :: Fractional u => Vec2 u -> LocGraphic u -- | straightLineGraphic : 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. straightLineGraphic :: Fractional u => Point2 u -> Point2 u -> Graphic u -- | curveGraphic : 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. curveGraphic :: Fractional u => Point2 u -> Point2 u -> Point2 u -> Point2 u -> Graphic u -- | strokedCircle : radius -> LocGraphic -- -- Create a stroked circle LocGraphic - the implicit point is -- center. The circle is drawn with four Bezier curves. -- -- The line properties (colour, pen thickness, etc.) are taken from the -- implicit DrawingContext. strokedCircle :: Floating u => u -> LocGraphic u -- | filledCircle : radius -> LocGraphic -- -- Create a filled circle LocGraphic - the implicit point is -- center. The circle is drawn with four Bezier curves. -- -- The fill colour is taken from the implicit DrawingContext. filledCircle :: Floating u => u -> LocGraphic u -- | borderedCircle : radius -> LocGraphic -- -- Create a bordered circle LocGraphic - the implicit point is -- center. The circle is drawn with four Bezier curves. -- -- The background fill colour and the outline stroke properties are taken -- from the implicit DrawingContext. borderedCircle :: Floating u => 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. strokedEllipse :: Floating u => u -> u -> LocGraphic u -- | rstrokedEllipse : x_radius * y_radius -> -- LocThetaGraphic -- -- Create a stroked ellipse LocThetaGraphic - the implicit point -- is center and the angle is rotation about the center. The ellipse is -- drawn with four Bezier curves. -- -- The line properties (colour, pen thickness, etc.) are taken from the -- implicit DrawingContext. rstrokedEllipse :: (Real u, Floating u) => u -> u -> LocThetaGraphic u -- | filledEllipse : x_radius * y_radius -> LocGraphic -- -- Create a filled ellipse LocGraphic - the implicit point is -- center. The ellipse is drawn with four Bezier curves. -- -- The fill colour is taken from the implicit DrawingContext. filledEllipse :: Floating u => u -> u -> LocGraphic u -- | rfilledEllipse : x_radius * y_radius -> LocGraphic -- -- -- Create a filled ellipse LocThetaGraphic - the implicit point is -- center and the angle is rotation about the center. The ellipse is -- drawn with four Bezier curves. -- -- The fill colour is taken from the implicit DrawingContext. rfilledEllipse :: (Real u, Floating u) => u -> u -> LocThetaGraphic u -- | borderedEllipse : x_radius * y_radius -> LocGraphic -- -- -- Create a bordered ellipse LocGraphic - the implicit point is -- center. The ellipse is drawn with four Bezier curves. -- -- The background fill colour and the outline stroke properties are taken -- from the implicit DrawingContext. borderedEllipse :: Floating u => u -> u -> LocGraphic u -- | rborderedEllipse : 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. rborderedEllipse :: (Real u, Floating u) => u -> u -> LocThetaGraphic u -- | strokedRectangle : 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. strokedRectangle :: Fractional u => u -> u -> LocGraphic u -- | filledRectangle : width * height -> LocGraphic -- -- Create a filled rectangle LocGraphic - the implicit point is -- the bottom-left. -- -- The fill colour is taken from the implicit DrawingContext. filledRectangle :: Fractional u => u -> u -> LocGraphic u -- | borderedRectangle : width * height -> LocGraphic -- -- Create a bordered rectangle LocGraphic - the implicit point is -- bottom-left. -- -- The background fill colour and the outline stroke properties are taken -- from the implicit DrawingContext. borderedRectangle :: Fractional u => u -> u -> LocGraphic u -- | strokedDisk : radius -> LocGraphic -- -- Create a stroked 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 -- strokedCircle instead. -- -- The line properties (colour, pen thickness, etc.) are taken from the -- implicit DrawingContext. strokedDisk :: Num u => u -> LocGraphic u -- | filledDisk : radius -> LocGraphic -- -- Create a filled 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. As the -- circle is filled rather than drawn with a "pen" a filledDisk -- can be scaled. -- -- The fill colour is taken from the implicit DrawingContext. filledDisk :: Num u => u -> LocGraphic u -- | borderedDisk : radius -> LocGraphic -- -- Create a bordered 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, bordereded circles do not draw well after non-uniform scaling -- - the pen width of the outline is scaled as well as the shape. -- -- For bordered circles that can be adequately scaled, use -- borderedCircle instead. -- -- The background fill colour and the outline stroke properties are taken -- from the implicit DrawingContext. borderedDisk :: Num u => u -> LocGraphic u -- | strokedEllipseDisk : 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. strokedEllipseDisk :: Num u => u -> u -> LocGraphic u -- | filledEllipseDisk : x_radius * y_radius -> LocGraphic -- -- -- Create a filled ellipse LocGraphic - the implicit point is the -- center. -- -- This is a efficient representation of ellipses using PostScript's -- arc or SVG's ellipse in the generated output. As the -- ellipse is filled rather than drawn with a "pen" a -- filledEllipseDisk can be scaled. -- -- The fill colour is taken from the implicit DrawingContext. filledEllipseDisk :: Num u => u -> u -> LocGraphic u -- | borderedEllipseDisk : x_radius * y_radius -> LocGraphic -- -- -- Create a bordered ellipse LocGraphic - the implicit point is -- the center. -- -- This is a efficient representation of ellipses using PostScript's -- arc or SVG's ellipse in the generated output. -- However, bordereded ellipses do not draw well after non-uniform -- scaling - the pen width of the outline is scaled as well as the shape. -- -- For bordered ellipses that can be adequately scaled, use -- borderedEllipse instead. -- -- The background fill colour and the outline stroke properties are taken -- from the implicit DrawingContext. borderedEllipseDisk :: Num u => u -> u -> LocGraphic u -- | Bounded versions of Graphic and LocGraphic. -- -- Bounded meaning they are actually Images that return the bounding box -- of the Graphic. module Wumpus.Basic.Kernel.Objects.Bounded -- | Graphic with a bounding box. type BoundedGraphic u = Image u (BoundingBox u) type DBoundedGraphic = BoundedGraphic Double -- | LocGraphic with a bounding box. type BoundedLocGraphic u = LocImage u (BoundingBox u) type DBoundedLocGraphic = BoundedLocGraphic Double -- | LocThetaGraphic with a bounding box. -- -- Note the size of bounding box for the "same" shape will vary according -- to the rotation. A bounding box is always orthonormal (?) to the x- -- and y-axes. type BoundedLocThetaGraphic u = LocThetaImage u (BoundingBox u) type DBoundedLocThetaGraphic = BoundedLocThetaGraphic Double -- | emptyBoundedLocGraphic : BoundedLocGraphic -- -- Build an empty BoundedLocGraphic. -- -- 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 :: Num u => BoundedLocGraphic u -- | emptyBoundedLocThetaGraphic : BoundedLocThetaGraphic -- -- Build an empty BoundedLocThetaGraphic. -- -- 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 (the implicit -- inclination can be ignored). emptyBoundedLocThetaGraphic :: Num u => BoundedLocThetaGraphic 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) => Radian -> BoundingBox u -> BoundingBox u illustrateBoundedGraphic :: Fractional u => BoundedGraphic u -> BoundedGraphic u illustrateBoundedLocGraphic :: Fractional u => BoundedLocGraphic u -> BoundedLocGraphic u illustrateBoundedLocThetaGraphic :: Fractional u => BoundedLocThetaGraphic u -> BoundedLocThetaGraphic u bbrectangle :: Fractional u => BoundingBox u -> Graphic 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.Objects.PosImage -- | Datatype enumerating positions within a rectangle that can be derived -- for a PosGraphic. data RectPosition CENTER :: RectPosition NN :: RectPosition SS :: RectPosition EE :: RectPosition WW :: RectPosition NE :: RectPosition NW :: RectPosition SE :: RectPosition SW :: RectPosition -- | Utility datatype representing orientation within a rectangular -- frame. ObjectPos 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 ObjectPos u ObjectPos :: !u -> !u -> !u -> !u -> ObjectPos u op_x_minor :: ObjectPos u -> !u op_x_major :: ObjectPos u -> !u op_y_minor :: ObjectPos u -> !u op_y_major :: ObjectPos u -> !u -- | A positionable Image. type PosImage u a = CF2 (Point2 u) RectPosition (ImageAns u a) -- | Version of PosImage specialized to Double for the unit type. type DPosImage a = PosImage Double a -- | A positionable Graphic. type PosGraphic u = PosImage u (UNil u) -- | Version of PosGraphic specialized to Double for the unit type. type DPosGraphic = PosGraphic Double -- | makePosImage : object_pos * loc_graphic -> PosGraphic -- -- -- Create a PosImage from an ObjectPos describing how it is -- orientated within a border rectangle and a LocImage that draws -- it. makePosImage :: Fractional u => ObjectPos u -> LocImage u a -> PosImage u a -- | startPos : pos_image * rect_pos -> LocImage -- -- Downcast a PosImage to a LocImage by supplying it -- with a RectPosition (start position). startPos :: Floating u => PosImage u a -> RectPosition -> LocImage u a -- | atStartPos : pos_image * start_point * rect_pos -> -- LocImage -- -- Downcast a PosGraphic to an Image by supplying it -- with an initial point and a RectPosition (start position). atStartPos :: Floating u => PosImage u a -> Point2 u -> RectPosition -> Image u a -- | Calculate the bounding box formed by locating the ObjectPos at -- the supplied point. objectPosBounds :: Fractional u => Point2 u -> RectPosition -> ObjectPos u -> BoundingBox u instance Eq u => Eq (ObjectPos u) instance Ord u => Ord (ObjectPos u) instance Show u => Show (ObjectPos u) instance Enum RectPosition instance Eq RectPosition instance Ord RectPosition instance Show RectPosition instance (Fractional u, Ord u) => OPlus (ObjectPos 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.Objects.TraceDrawing data TraceDrawing u a type DTraceDrawing a = TraceDrawing Double a data TraceDrawingT u m a type DTraceDrawingT m a = TraceDrawingT Double m 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 runTraceDrawingT :: Monad m => DrawingContext -> TraceDrawingT u m a -> m (a, HPrim u) execTraceDrawingT :: Monad m => DrawingContext -> TraceDrawingT u m a -> m (HPrim u) evalTraceDrawingT :: Monad m => DrawingContext -> TraceDrawingT u m a -> m a -- | Unsafe promotion of HPrim to Picture. -- -- If the HPrim is empty, a run-time error is thrown. liftToPictureU :: (Real u, Floating u, FromPtSize u) => HPrim u -> Picture u -- | Safe promotion of HPrim to (Maybe Picture). -- -- If the HPrim is empty, then Nothing is returned. liftToPictureMb :: (Real u, Floating u, FromPtSize u) => HPrim u -> Maybe (Picture u) -- | 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 :: (Real u, Floating u, FromPtSize u) => Maybe (Picture u) -> Picture u query :: DrawingCtxM m => CF a -> m a -- | Draw a Graphic taking the drawing style from the drawing -- context. -- -- This operation is analogeous to tell in a Writer monad. draw :: (TraceM m, DrawingCtxM m, u ~ (MonUnit m)) => Graphic u -> m () -- | Hyperlink version of draw. xdraw :: (TraceM m, DrawingCtxM m, u ~ (MonUnit m)) => XLink -> Graphic u -> m () -- | 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 :: (TraceM m, DrawingCtxM m, u ~ (MonUnit m)) => Image u a -> m a -- | Forgetful drawi. drawi_ :: (TraceM m, DrawingCtxM m, (MonUnit m) ~ u) => Image u a -> m () -- | Hyperlink version of drawi. xdrawi :: (TraceM m, DrawingCtxM m, (MonUnit m) ~ u) => XLink -> Image u a -> m a -- | Forgetful xdrawi. xdrawi_ :: (TraceM m, DrawingCtxM m, (MonUnit m) ~ u) => XLink -> Image u a -> m () node :: (TraceM m, DrawingCtxM m, PointSupplyM m, (MonUnit m) ~ u) => LocGraphic u -> m () nodei :: (TraceM m, DrawingCtxM m, PointSupplyM m, (MonUnit m) ~ u) => LocImage u a -> m a instance Monad m => DrawingCtxM (TraceDrawingT u m) instance DrawingCtxM (TraceDrawing u) instance Monad m => TraceM (TraceDrawingT u m) instance TraceM (TraceDrawing u) instance Monad m => Monad (TraceDrawingT u m) instance Monad (TraceDrawing u) instance Monad m => Applicative (TraceDrawingT u m) instance Applicative (TraceDrawing u) instance Monad m => Functor (TraceDrawingT u m) instance Functor (TraceDrawing u) -- | Anchor points on shapes, bounding boxes, etc. -- -- Anchors are addressable positions, an examplary use is taking anchors -- on node shapes to get the start and end points for connectors in a -- network (graph) diagram. -- -- ** WARNING ** - The API here needs some thought as to a good balance -- of the type classes - in a nutshell "are corners better than -- cardinals". Originally I tried to follow how I understand the TikZ -- anchors to work, but this is perhaps not ideal for dividing into -- type-classes. module Wumpus.Basic.Kernel.Base.Anchors -- | Center of an object. class CenterAnchor t center :: (CenterAnchor t, (DUnit t) ~ u) => t -> Point2 u -- | Apex of an object. class ApexAnchor t apex :: (ApexAnchor t, (DUnit t) ~ u) => t -> Point2 u -- | Cardinal (compass) positions on an object. -- -- Note - in TikZ cardinal anchors are not necessarily at the equivalent -- radial position, for instance reactangle north-east is the top-right -- corner whether or not this is incident at 45deg. -- -- Wumpus generally follows the TikZ convention. class CardinalAnchor t north :: (CardinalAnchor t, (DUnit t) ~ u) => t -> Point2 u south :: (CardinalAnchor t, (DUnit t) ~ u) => t -> Point2 u east :: (CardinalAnchor t, (DUnit t) ~ u) => t -> Point2 u west :: (CardinalAnchor t, (DUnit t) ~ u) => t -> Point2 u -- | Secondary group of cardinal (compass) positions on an object. -- -- 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 t northeast :: (CardinalAnchor2 t, (DUnit t) ~ u) => t -> Point2 u southeast :: (CardinalAnchor2 t, (DUnit t) ~ u) => t -> Point2 u southwest :: (CardinalAnchor2 t, (DUnit t) ~ u) => t -> Point2 u northwest :: (CardinalAnchor2 t, (DUnit t) ~ u) => t -> Point2 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 t radialAnchor :: (RadialAnchor t, (DUnit t) ~ u) => Radian -> t -> Point2 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 t topLeftCorner :: (TopCornerAnchor t, (DUnit t) ~ u) => t -> Point2 u topRightCorner :: (TopCornerAnchor t, (DUnit t) ~ u) => t -> Point2 u -- | Anchors at the bottom left and right corners of a shape. class BottomCornerAnchor t bottomLeftCorner :: (BottomCornerAnchor t, (DUnit t) ~ u) => t -> Point2 u bottomRightCorner :: (BottomCornerAnchor t, (DUnit t) ~ u) => t -> Point2 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 t sideMidpoint :: (SideMidpointAnchor t, (DUnit t) ~ u) => Int -> t -> Point2 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, u ~ (DUnit t), CenterAnchor t) => (t -> Point2 u) -> u -> t -> Point2 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 t1, RadialAnchor t1, CenterAnchor t2, RadialAnchor t2, u ~ (DUnit t1), (DUnit t1) ~ (DUnit t2)) => t1 -> t2 -> (Point2 u, Point2 u) instance Fractional u => CardinalAnchor2 (BoundingBox u) instance Fractional u => CardinalAnchor (BoundingBox u) instance Fractional u => CenterAnchor (BoundingBox 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.Objects.CtxPicture -- | A Contextual Picture. -- -- This type corresponds to the Picture type in Wumpus-Core, but -- it is embedded with a DrawingContext (for font properties, fill -- colour etc.). So it is a function from DrawingContext to -- Picture. -- -- Internally the result is actually a (Maybe Picture) and not a Picture, -- this is a trick to promote the extraction from possibly empty drawings -- (created by TraceDrawing) to the top-level of the type hierarchy where -- client code can deal with empty drawings explicitly (empty Pictures -- cannot be rendered by Wumpus-Core). -- -- 
--   a `oplus` b
--
-- -- The OPlus (semigroup) instance for CtxPicture draws -- picture a in front of picture b in the z-order, neither picture is -- moved. (Usually the picture composition operators in this module move -- the second picture aligning it somehow with the first). data CtxPicture u -- | Version of CtxPicture specialized to Double for the unit type. type DCtxPicture = CtxPicture Double -- | 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 u -> Maybe (Picture u) -- | 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 u -> Picture u -- | drawTracing : trace_drawing -> CtxPicture -- -- Transform a TraceDrawing into a CtxPicture. drawTracing :: (Real u, Floating u, FromPtSize u) => TraceDrawing u a -> CtxPicture u -- | clipCtxPicture : path * ctx_picture -> CtxPicture -- -- Clip a picture with a path. clipCtxPicture :: (Num u, Ord u) => PrimPath u -> CtxPicture u -> CtxPicture u -- | mapCtxPicture : trafo * ctx_picture -> CtxPicture -- -- Apply a picture transformation function to the Picture warpped -- in a CtxPicture. mapCtxPicture :: (Picture u -> Picture u) -> CtxPicture u -> CtxPicture u -- | cxpBeneath : ctx_picture1 * ctx_picture2 -> CtxPicture -- -- -- 
--   a `cxpBeneath` b
--
-- -- Similarly beneath draws the first picture behind the second -- picture in the z-order, neither picture is moved. cxpBeneath :: (Num u, Ord u) => CtxPicture u -> CtxPicture u -> CtxPicture u -- | 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 
--
cxpUniteCenter :: (Fractional u, Ord u) => CtxPicture u -> CtxPicture u -> CtxPicture u -- | 
--   a `cxpRight` b
--
-- -- Horizontal composition - position picture b to the right of -- picture a. cxpRight :: (Num u, Ord u) => CtxPicture u -> CtxPicture u -> CtxPicture u -- | 
--   a `cxpDown` b
--
-- -- Vertical composition - position picture b down from -- picture a. cxpDown :: (Num u, Ord u) => CtxPicture u -> CtxPicture u -> CtxPicture u -- | Center the picture at the supplied point. cxpCenteredAt :: (Fractional u, Ord u) => CtxPicture u -> Point2 u -> CtxPicture u -- | cxpRow : ctx_picture1 * [ctx_picture] -> CtxPicture -- -- -- Make a row of pictures concatenating them horizontally. -- -- Note - this function is in destructor form. As Wumpus cannot -- make a Picture from an empty list of Pictures, destructor form -- decomposes the list into the head and the rest in -- the function signature, rather than take a possibly empty list and -- have to throw an error. cxpRow :: (Real u, Floating u, FromPtSize u) => CtxPicture u -> [CtxPicture u] -> CtxPicture u -- | cxpColumn : ctx_picture1 * [ctx_picture] -> CtxPicture -- -- -- Make a column of pictures concatenating them vertically. -- -- Note - this function is in destructor form. cxpColumn :: (Real u, Floating u, FromPtSize u) => CtxPicture u -> [CtxPicture u] -> CtxPicture u -- | 
--   cxpRightSep n a b
--
-- -- Horizontal composition - move b, placing it to the right of -- a with a horizontal gap of n separating the -- pictures. cxpRightSep :: (Num u, Ord u) => u -> CtxPicture u -> CtxPicture u -> CtxPicture u -- | 
--   cxpDownSep n a b
--
-- -- Vertical composition - move b, placing it below a -- with a vertical gap of n separating the pictures. cxpDownSep :: (Num u, Ord u) => u -> CtxPicture u -> CtxPicture u -> CtxPicture u -- | 
--   picRowSep n x xs
--
-- -- Concatenate the list of pictures xs horizontally with -- hspace starting at x. The pictures are interspersed -- with spaces of n units. cxpRowSep :: (Real u, Floating u, FromPtSize u) => u -> CtxPicture u -> [CtxPicture u] -> CtxPicture u -- | 
--   vsepPic n xs
--
-- -- Concatenate the list of pictures xs vertically with -- vspace starting at x. The pictures are interspersed -- with spaces of n units. cxpColumnSep :: (Real u, Floating u, FromPtSize u) => u -> CtxPicture u -> [CtxPicture u] -> CtxPicture u -- | 
--   cxpAlignH align a b
--
-- -- Horizontal composition - move b, placing it to the right of -- a and align it with the top, center or bottom of a. cxpAlignH :: (Fractional u, Ord u) => HAlign -> CtxPicture u -> CtxPicture u -> CtxPicture u -- | 
--   cxpAlignV align a b
--
-- -- Vertical composition - move b, placing it below a -- and align it with the left, center or right of a. cxpAlignV :: (Fractional u, Ord u) => VAlign -> CtxPicture u -> CtxPicture u -> CtxPicture u -- | 
--   cxpAlignSepH align sep a b
--
-- -- Spacing version of cxpAlignH - move b to the right of -- a separated by sep units, align b according -- to align. cxpAlignSepH :: (Fractional u, Ord u) => HAlign -> u -> CtxPicture u -> CtxPicture u -> CtxPicture u -- | 
--   cxpAlignSepV align sep a b
--
-- -- Spacing version of alignV - move b below a separated -- by sep units, align b according to align. cxpAlignSepV :: (Fractional u, Ord u) => VAlign -> u -> CtxPicture u -> CtxPicture u -> CtxPicture u -- | Variant of cxpRow that aligns the pictures as well as -- concatenating them. cxpAlignRow :: (Real u, Floating u, FromPtSize u) => HAlign -> CtxPicture u -> [CtxPicture u] -> CtxPicture u -- | Variant of cxpColumn that aligns the pictures as well as -- concatenating them. cxpAlignColumn :: (Real u, Floating u, FromPtSize u) => VAlign -> CtxPicture u -> [CtxPicture u] -> CtxPicture u -- | Variant of cxpRow that aligns the pictures as well as -- concatenating and spacing them. cxpAlignRowSep :: (Real u, Floating u, FromPtSize u) => HAlign -> u -> CtxPicture u -> [CtxPicture u] -> CtxPicture u -- | Variant of cxpColumn that aligns the pictures as well as -- concatenating and spacing them. cxpAlignColumnSep :: (Real u, Floating u, FromPtSize u) => VAlign -> u -> CtxPicture u -> [CtxPicture u] -> CtxPicture u instance (Num u, Ord u) => OPlus (CtxPicture u) instance (Num u, Ord u) => Translate (CtxPicture u) instance (Num u, Ord u) => Scale (CtxPicture u) instance (Real u, Floating u) => RotateAbout (CtxPicture u) instance (Real u, Floating u) => Rotate (CtxPicture u) -- | Quadrants and trigonometric calculations. -- -- ** - WARNING ** - in progress. module Wumpus.Basic.Geometry.Quadrant 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 -- | qiModulo : ang -> Radian -- -- Modulo an angle so it lies in quadrant I (north east), i.e. modulo -- into the range 0..(pi/2). qiModulo :: Radian -> Radian -- | rectRadialVector : half_width * half_height * ang -> -- Vec -- -- Find where a radial line extended from (0,0) with the elevation -- ang intersects with an enclosing rectangle. The rectangle is -- centered at (0,0). -- -- Internally the calculation is made in quadrant I (north east), -- symmetry is used to translate result to the other quadrants. rectRadialVector :: (Real u, Floating u) => u -> u -> Radian -> Vec2 u -- | rectangleQI : width * height * ang -> Vec -- -- Find where a line from (0,0) in direction ang intersects the -- top or right side of a rectangle in QI (left side is the y-axis, -- bottom is the x-axis). -- -- 
--   ang must be in the @range 0 < ang <= 90 deg@.
--   
--   width and height must be positive.
--
rectangleQI :: (Real u, Floating u) => u -> u -> Radian -> Vec2 u -- | diamondRadialVector : half_width * half_height * ang -> -- Vec -- -- Find where a radial line extended from (0,0) with the elevation -- ang intersects with an enclosing diamond. The diamond is -- centered at (0,0). -- -- Internally the calculation is made in quadrant I (north east), -- symmetry is used to translate result to the other quadrants. diamondRadialVector :: (Real u, Floating u) => u -> u -> Radian -> Vec2 u -- | triangleRadialVector : half_base_width * height_minor * -- height_minor * ang -> Vec -- -- Find where a radial line extended from (0,0) with the elevation -- ang intersects with an enclosing triangle. The triangle has -- the centroid at (0,0), so solutions in quadrants I and II are -- intersections with a simple line. Intersections in quadrants III and -- IV can intersect either the respective side or the base. triangleRadialVector :: (Real u, Floating u) => u -> u -> u -> Radian -> Vec2 u -- | triangleQI : width * height * ang -> Vec -- -- Find where a line from (0,0) with elevation ang intersects -- the hypotenuse a right triangle in QI (the legs of the triangle take -- the x and y-axes). -- -- 
--   ang must be in the @range 0 < ang <= 90@.
--   
--   width and height must be positive.
--
triangleQI :: (Real u, Floating u) => u -> u -> Radian -> Vec2 u -- | rightTrapezoidQI : top_width * height * top_right_ang -- -> Vec -- -- Find where a line from (0,0) with elevation ang intersects -- the either the lines A_B or B_D in a right trapezoid in QI. -- -- The right trapezoid has a variable right side. Left side is the y-axis -- (C_A), bottom side is the x-axis (C_D), top side is parallel to the -- x-axis (A_B). -- -- 
--   A   B
--   -----
--   |    \
--   |     \     
--   -------
--   C      D
--
-- -- 
--   A      B
--   -------
--   |     /
--   |    /     
--   -----
--   C   D
--
-- -- 
--   ang must be in the range 0 < ang <= 90.
--   
--   top_width and height must be positive.
--
rightTrapezoidQI :: (Real u, Floating u) => u -> u -> Radian -> Radian -> Vec2 u -- | rightTrapeziumBaseWidth : top_width * height * -- top_right_ang -> Length -- -- Find the length of the line C_D: -- -- 
--   A   B
--   -----
--   |    \
--   |     \     
--   -------
--   C      D
--
-- -- 
--   A      B
--   -------
--   |     /
--   |    /     
--   -----
--   C   D
--
rightTrapeziumBaseWidth :: Fractional u => u -> u -> Radian -> u instance Enum Quadrant instance Eq Quadrant instance Ord Quadrant instance Show Quadrant -- | Paths for elementary shapes - rectangles... -- -- ** - WARNING ** - half baked. module Wumpus.Basic.Geometry.Paths -- | A functional type from initial point to point list. type LocCoordPath u = Point2 u -> [Point2 u] coordinatePrimPath :: Num u => Point2 u -> LocCoordPath u -> PrimPath u -- | Supplied point is bottom-left, subsequenct points are -- counter-clockise so [ bl, br, tr, tl ] . rectangleCoordPath :: Num u => u -> u -> LocCoordPath u -- | diamondPath : half_width * half_height * center_point -- -> PrimPath diamondCoordPath :: Num u => u -> u -> LocCoordPath u -- | polygonCoordPath : num_points * radius * center -> -- [point] polygonCoordPath :: Floating u => Int -> u -> LocCoordPath u -- | 
--   isocelesTriangle bw h pt
--
-- -- Supplied point is the centriod of the triangle. This has a nicer -- visual balance than using half-height. isoscelesTriangleCoordPath :: Floating u => u -> u -> LocCoordPath u -- | 
--   isocelesTriangle bw h pt
--
-- -- Supplied point is the centriod of the triangle. This has a nicer -- visual balance than using half-height. isoscelesTrianglePoints :: Floating u => u -> u -> Point2 u -> (Point2 u, Point2 u, Point2 u) -- | 
--   side_length * ctr -> [Points]
--
equilateralTriangleCoordPath :: Floating u => u -> LocCoordPath u equilateralTrianglePoints :: Floating u => u -> Point2 u -> (Point2 u, Point2 u, Point2 u) -- | Import shim for Wumpus.Basic.Kernel modules. module Wumpus.Basic.Kernel -- | Font loader / import shim for the Adobe "Core 14" glyph metrics. -- -- Use this loader if you have the Adode glyph metrics set (AFM v4.1). -- This metrics set is avaiable from the Adobe website. module Wumpus.Basic.System.FontLoader.Afm -- | loadAfmMetrics : path_to_afm_fonts * [font_name] -> IO -- (metrics, messages) -- -- 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. loadAfmMetrics :: FilePath -> [FontName] -> IO (GlyphMetrics, [String]) -- | Font loader / import shim for GhostScript glyph metrics. -- -- Use this loader if you have GhostScript installed and you want to use -- the (AFM v2.0) metrics that are distributed with GhostScript. module Wumpus.Basic.System.FontLoader.GhostScript -- | loadGSMetrics : path_to_gs_fonts * [font_name] -> IO -- (metrics, messages) -- -- 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. loadGSMetrics :: FilePath -> [FontName] -> IO (GlyphMetrics, [String]) -- | Base geometric types and operations. module Wumpus.Basic.Geometry.Base half_pi :: Floating u => u two_pi :: Floating u => u -- | 2x2 matrix, considered to be in row-major form. -- -- 
--   (M2'2 a b
--         c d)
--
data Matrix2'2 u M2'2 :: !u -> !u -> !u -> !u -> Matrix2'2 u type DMatrix2'2 = Matrix2'2 Double -- | Construct the identity 2x2 matrix: -- -- 
--   (M2'2 1 0 
--         0 1 )
--
identity2'2 :: Num u => Matrix2'2 u -- | Determinant of a 2x2 matrix. det2'2 :: Num u => Matrix2'2 u -> u -- | Transpose a 2x2 matrix. transpose2'2 :: Matrix2'2 u -> Matrix2'2 u -- | Line in equational form, i.e. Ax + By + C = 0. data LineEquation u LineEquation :: !u -> !u -> !u -> LineEquation u line_eqn_A :: LineEquation u -> !u line_eqn_B :: LineEquation u -> !u line_eqn_C :: LineEquation u -> !u type DLineEquation = LineEquation Double -- | lineEquation : point1 * point2 -> LineEquation -- -- Construct a line in equational form bisecting the supplied points. lineEquation :: Num u => Point2 u -> Point2 u -> LineEquation u -- | pointViaX : x * line_equation -> Point -- -- Calculate the point on the line for the supplied x value. pointViaX :: Fractional u => u -> LineEquation u -> Point2 u -- | pointViaY : y * line_equation -> Point -- -- Calculate the point on the line for the supplied y value. pointViaY :: Fractional u => u -> LineEquation u -> Point2 u -- | pointLineDistance : point -> line -> Distance -- -- Find the distance from a point to a line in equational form using this -- formula: -- -- 
--   P(u,v) 
--   L: Ax + By + C = 0
--   
--   (A*u) + (B*v) + C 
--   -----------------
--   sqrt $ (A^2) +(B^2)
--
-- -- A positive distance indicates the point is above the line, negative -- indicates below. pointLineDistance :: Floating u => Point2 u -> LineEquation u -> u data LineSegment u LineSegment :: (Point2 u) -> (Point2 u) -> LineSegment u type DLineSegment = LineSegment Double -- | rectangleLineSegments : half_width * half_height -> -- [LineSegment] -- -- Compute the line segments of a rectangle. rectangleLineSegments :: Num u => u -> u -> Point2 u -> [LineSegment u] -- | polygonLineSegments : [point] -> [LineSegment] -- -- Build the line segments of a polygon fome a list of its vertices. polygonLineSegments :: [Point2 u] -> [LineSegment u] -- | A Strict cubic Bezier curve. data BezierCurve u BezierCurve :: !Point2 u -> !Point2 u -> !Point2 u -> !Point2 u -> BezierCurve u type DBezierCurve = BezierCurve Double -- | bezierLength : start_point * control_1 * control_2 * -- end_point -> Length -- -- Find the length of a Bezier curve. The result is an approximation, -- with the tolerance is 0.1 of a point. This seems good enough -- for drawing (potentially the tolerance could be larger still). -- -- The result is found through repeated subdivision so the calculation is -- potentially costly. bezierLength :: (Floating u, Ord u, FromPtSize u) => BezierCurve u -> u -- | Curve subdivision via de Casteljau's algorithm. subdivide :: Fractional u => BezierCurve u -> (BezierCurve u, BezierCurve u) -- | subdivide with an affine weight along the line... subdividet :: Real u => u -> BezierCurve u -> (BezierCurve u, BezierCurve u) -- | bezierArcPoints : apex_angle * radius * rotation * 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 -> BezierCurve u -- | Affine combination... affineComb :: Real u => u -> Point2 u -> Point2 u -> Point2 u -- | midpoint : start_point * end_point -> Midpoint -- -- Mid-point on the line formed between the two supplied points. midpoint :: Fractional u => Point2 u -> Point2 u -> Point2 u -- | lineAngle : start_point * end_point -> Angle -- -- Calculate the counter-clockwise angle between the line formed by the -- two points and the horizontal plane. lineAngle :: (Floating u, Real u) => Point2 u -> Point2 u -> Radian instance Eq u => Eq (BezierCurve u) instance Ord u => Ord (BezierCurve u) instance Show u => Show (BezierCurve u) instance Eq u => Eq (LineSegment u) instance Ord u => Ord (LineSegment u) instance Show u => Show (LineSegment u) instance Eq u => Eq (LineEquation u) instance Show u => Show (LineEquation u) instance Eq u => Eq (Matrix2'2 u) instance Num u => Num (Matrix2'2 u) instance Show u => Show (Matrix2'2 u) instance Functor Matrix2'2 -- | Intersection of line to line and line to plane. -- -- ** - WARNING ** - this uses quite a high tolerance for floating point -- equality. module Wumpus.Basic.Geometry.Intersection data LineSegment u -- | interLineLine : line1 * line2 -> Maybe Point -- -- Find the intersection of two lines, if there is one. -- -- Lines are infinite they are represented by points on them, they are -- not line segments. -- -- An answer of Nothing may indicate wither the lines coincide -- or the are parallel. interLineLine :: Fractional u => (Point2 u, Point2 u) -> (Point2 u, Point2 u) -> Maybe (Point2 u) -- | interLinesegLineseg : line_segment1 * line_segment2 -> -- Maybe Point -- -- Find the intersection of two line segments, if there is one. -- -- An answer of Nothing indicates that the line segments -- coincide, or that there is no intersection. interLinesegLineseg :: (Fractional u, Ord u, FromPtSize u) => LineSegment u -> LineSegment u -> Maybe (Point2 u) -- | interLinesegLine : line_segment * line -> Maybe Point -- -- -- Find the intersection of a line and a line segment, if there is one. -- -- An answer of Nothing indicates that the the line and line -- segment coincide, or that there is no intersection. interLinesegLine :: (Fractional u, Ord u, FromPtSize u) => LineSegment u -> (Point2 u, Point2 u) -> Maybe (Point2 u) interCurveLine :: (Floating u, Ord u, FromPtSize u) => BezierCurve u -> (Point2 u, Point2 u) -> Maybe (Point2 u) -- | findIntersect :: radial_origin * theta * [line_segment] -- -> Maybe Point -- -- Find the first intersection of a line through radial_origin -- at angle theta and the supplied line segments, if there is -- one. findIntersect :: (Floating u, Real u, Ord u, FromPtSize u) => Point2 u -> Radian -> [LineSegment u] -> Maybe (Point2 u) -- | makePlane : point * ang -> Line -- -- Make an infinite line / plane passing through the supplied with -- elevation ang. makePlane :: Floating u => Point2 u -> Radian -> (Point2 u, Point2 u) -- | rectangleLineSegments : half_width * half_height -> -- [LineSegment] -- -- Compute the line segments of a rectangle. rectangleLineSegments :: Num u => u -> u -> Point2 u -> [LineSegment u] -- | polygonLineSegments : [point] -> [LineSegment] -- -- Build the line segments of a polygon fome a list of its vertices. polygonLineSegments :: [Point2 u] -> [LineSegment u]