-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Common drawing utilities built on wumpus-core. -- -- ** WARNING ** - this package is sub-alpha, it was released to Hackage -- prematurely and while its capabilities have improved with subsequent -- updates it is arguably becoming even less stable and more experimental -- (unfortunately the only thing consistent about the API is that it -- consistently changes...). -- -- Version 0.14.0 breaks up Wumpus-Basic into two layers - -- Wumpus.Basic for core data types, general utilities and -- System utilities (currently only font loading); the other -- layer, Wumpus.Drawing, is for for specific drawing "objects" -- - arrowheads, dots, and the like. The APIs of the Drawing -- modules have not been given much attention as the underlying graphic -- types have changed, they are due for substantial revision. This -- includes modules that were previously considered fairly stable such as -- the Basic.SafeFonts module which no longer seems very SVG -- safe. -- -- NOTE - many of the demos now use font metrics. Font metrics for the -- "Core 14" PostScript fonts are distributed as *.afm files -- with GhostScript in the fonts directory. Wumpus expects the -- GhostScript font metrics to be AFM version 2.0 files (this matches -- GhostScript 8.63). Alternatively, metrics for the Core 14 fonts are -- available from Adode (AFM version 4.1), see the links below. To run -- the demos properly you will need one of these sets of metrics. -- -- Adobe Font techinal notes: -- https://www.adobe.com/devnet/font.html -- -- Core 14 AFM metrics: -- https://www.adobe.com/content/dam/Adobe/en/devnet/font/pdfs/Core14_AFMs.tar -- -- Also note that Wumpus uses fallback metrics (derived from the -- monospaced Courier font) when font loading fails, rather than throwing -- a terminal error. Applications should ideally check the font loading -- log to ensure that fonts have loaded correctly (the demos print this -- log to standard out). -- -- Changelog: -- -- v0.13.0 to v0.14.0: -- -- -- -- v0.12.0 to v0.13.0: -- -- @package wumpus-basic @version 0.14.0 -- | Turtle monad and monad transformer. -- -- The Turtle monad embodies the LOGO style of imperative drawing - -- sending commands to update the a cursor. -- -- While Wumpus generally aims for a more compositional, -- "coordinate-free" style of drawing, some types of diagram are more -- easily expressed in the LOGO style. -- -- Note - as turtle drawing with Wumpus is a local effect, there -- is only one instance of TurtleM. Potentially TurtleM will be removed -- and the functions implemented directly. module Wumpus.Drawing.Turtle.TurtleClass type Coord = (Int, Int) class Monad m => TurtleM m getLoc :: TurtleM m => m (Int, Int) setLoc :: TurtleM m => (Int, Int) -> m () getOrigin :: TurtleM m => m (Int, Int) setOrigin :: TurtleM m => (Int, Int) -> m () setsLoc :: TurtleM m => (Coord -> (a, Coord)) -> m a setsLoc_ :: TurtleM m => (Coord -> Coord) -> m () resetLoc :: TurtleM m => m () moveLeft :: TurtleM m => m () moveRight :: TurtleM m => m () moveUp :: TurtleM m => m () moveDown :: TurtleM m => m () nextLine :: TurtleM m => m () -- | Safe to use "Core 13" fonts that are expected to be present for any -- PostScript interpreter. -- -- Note - regrettably Symbol is not safe to use for SVG. -- -- ** WARNING ** - this module is in flux due to changes to Text encoding -- in Wumpus-Core and adding font metrics to Wumpus-Basic. The code here -- is likely to be revised. module Wumpus.Drawing.Text.SafeFonts -- | Times-Roman times_roman :: FontFace -- | Times Italic times_italic :: FontFace -- | Times Bold times_bold :: FontFace -- | Times Bold Italic times_bold_italic :: FontFace -- | Helvetica helvetica :: FontFace -- | Helvetica Oblique helvetica_oblique :: FontFace -- | Helvetica Bold helvetica_bold :: FontFace -- | Helvetica Bold Oblique helvetica_bold_oblique :: FontFace -- | Courier courier :: FontFace -- | Courier Oblique courier_oblique :: FontFace -- | Courier Bold courier_bold :: FontFace -- | Courier Bold Oblique courier_bold_oblique :: FontFace -- | Symbol -- -- Note - Symbol is intentionally not supported for SVG by some renderers -- (Firefox). Chrome is fine, but the use of symbol should be still be -- avoided for web graphics. symbol :: FontFace -- | Extended path type - more amenable for complex drawings than the type -- in Wumpus-Core. -- -- ** WARNING ** this module is an experiment, and may change -- significantly or even be dropped from future revisions. module Wumpus.Drawing.Paths.Base data Path u type DPath = Path Double length :: Num u => Path u -> u append :: Floating u => Path u -> Path u -> Path u pconcat :: Floating u => Path u -> [Path u] -> Path u line :: Floating u => Point2 u -> Point2 u -> Path u curve :: (Floating u, Ord u) => Point2 u -> Point2 u -> Point2 u -> Point2 u -> Path u -- | A draw a straight line of length 0 at the supplied point. -- -- This is might be useful in concatenating curved paths as it -- introduces and extra control point. pivot :: Floating u => Point2 u -> Path u -- | traceLinePoints throws a runtime error if the supplied list is -- empty. traceLinePoints :: Floating u => [Point2 u] -> Path u -- | traceCurvePoints consumes 4 points from the list on the intial -- step (start, control1, control2, end) then steps through the list -- taking 3 points at a time thereafter (control1,control2, end). -- Leftover points are discarded. -- -- traceCurvePoints throws a runtime error if the supplied list is -- has less than 4 elements (start, control1, control2, end). traceCurvePoints :: (Floating u, Ord u) => [Point2 u] -> Path u curveByAngles :: (Floating u, Ord u) => Point2 u -> Radian -> Radian -> Point2 u -> Path u -- | Turn a Path into an ordinary PrimPath. -- -- Assumes path is properly formed - i.e. end point of one segment is the -- same point as the start point of the next segment. toPrimPath :: Num u => Path u -> PrimPath u tipL :: Path u -> Point2 u tipR :: Path u -> Point2 u -- | Shorten both ends... -- -- u should be less-than half the path length shortenBoth :: (Real u, Floating u) => u -> Path u -> Path u -- | Note - shortening a line from the left by greater-than-or-equal its -- length is operationally equivalent to making a zero-length line at the -- end point. shortenL :: (Real u, Floating u) => u -> Path u -> Path u -- | Note - shortening a line from the right by greater-than-or-equal its -- length is operationally equivalent to making a zero-length line at the -- start point. shortenR :: (Real u, Floating u) => u -> Path u -> Path u -- | Direction of empty path is considered to be 0. directionL :: (Real u, Floating u) => Path u -> Radian -- | Direction of empty path is considered to be 0. directionR :: (Real u, Floating u) => Path u -> Radian midway :: (Real u, Floating u) => Path u -> (Point2 u, Radian) midway_ :: (Real u, Floating u) => Path u -> Point2 u atstart :: (Real u, Floating u) => Path u -> (Point2 u, Radian) atstart_ :: Path u -> Point2 u atend :: (Real u, Floating u) => Path u -> (Point2 u, Radian) atend_ :: Path u -> Point2 u data PathViewL u PathOneL :: (PathSegment u) -> PathViewL u (:<<) :: PathSegment u -> Path u -> PathViewL u type DPathViewL = PathViewL Double data PathViewR u PathOneR :: (PathSegment u) -> PathViewR u (:>>) :: Path u -> PathSegment u -> PathViewR u type DPathViewR = PathViewR Double data PathSegment u Line1 :: (Point2 u) -> (Point2 u) -> PathSegment u Curve1 :: (Point2 u) -> (Point2 u) -> (Point2 u) -> (Point2 u) -> PathSegment u type DPathSegment = PathSegment Double pathViewL :: Num u => Path u -> PathViewL u pathViewR :: Num u => Path u -> PathViewR u instance Eq u => Eq (PathSegment u) instance Ord u => Ord (PathSegment u) instance Show u => Show (PathSegment u) instance Eq u => Eq (PathViewR u) instance Ord u => Ord (PathViewR u) instance Show u => Show (PathViewR u) instance Eq u => Eq (PathViewL u) instance Ord u => Ord (PathViewL u) instance Show u => Show (PathViewL u) instance Eq u => Eq (PathSeg u) instance Ord u => Ord (PathSeg u) instance Show u => Show (PathSeg u) instance Eq u => Eq (Path u) instance Ord u => Ord (Path u) instance Show u => Show (Path u) -- | The X11 'named colours', as rgb [0,1] values module Wumpus.Drawing.Colour.X11Colours antique_white1 :: RGBi antique_white2 :: RGBi antique_white3 :: RGBi antique_white4 :: RGBi aquamarine1 :: RGBi aquamarine2 :: RGBi aquamarine3 :: RGBi aquamarine4 :: RGBi azure1 :: RGBi azure2 :: RGBi azure3 :: RGBi azure4 :: RGBi bisque1 :: RGBi bisque2 :: RGBi bisque3 :: RGBi bisque4 :: RGBi blue1 :: RGBi blue2 :: RGBi blue3 :: RGBi blue4 :: RGBi brown1 :: RGBi brown2 :: RGBi brown3 :: RGBi brown4 :: RGBi burlywood1 :: RGBi burlywood2 :: RGBi burlywood3 :: RGBi burlywood4 :: RGBi cadet_blue1 :: RGBi cadet_blue2 :: RGBi cadet_blue3 :: RGBi cadet_blue4 :: RGBi chartreuse1 :: RGBi chartreuse2 :: RGBi chartreuse3 :: RGBi chartreuse4 :: RGBi chocolate1 :: RGBi chocolate2 :: RGBi chocolate3 :: RGBi chocolate4 :: RGBi coral1 :: RGBi coral2 :: RGBi coral3 :: RGBi coral4 :: RGBi cornsilk1 :: RGBi cornsilk2 :: RGBi cornsilk3 :: RGBi cornsilk4 :: RGBi cyan1 :: RGBi cyan2 :: RGBi cyan3 :: RGBi cyan4 :: RGBi dark_goldenrod1 :: RGBi dark_goldenrod2 :: RGBi dark_goldenrod3 :: RGBi dark_goldenrod4 :: RGBi dark_olive_green1 :: RGBi dark_olive_green2 :: RGBi dark_olive_green3 :: RGBi dark_olive_green4 :: RGBi dark_orange1 :: RGBi dark_orange2 :: RGBi dark_orange3 :: RGBi dark_orange4 :: RGBi dark_orchid1 :: RGBi dark_orchid2 :: RGBi dark_orchid3 :: RGBi dark_orchid4 :: RGBi dark_sea_green1 :: RGBi dark_sea_green2 :: RGBi dark_sea_green3 :: RGBi dark_sea_green4 :: RGBi dark_slate_gray1 :: RGBi dark_slate_gray2 :: RGBi dark_slate_gray3 :: RGBi dark_slate_gray4 :: RGBi deep_pink1 :: RGBi deep_pink2 :: RGBi deep_pink3 :: RGBi deep_pink4 :: RGBi deep_sky_blue1 :: RGBi deep_sky_blue2 :: RGBi deep_sky_blue3 :: RGBi deep_sky_blue4 :: RGBi dodger_blue1 :: RGBi dodger_blue2 :: RGBi dodger_blue3 :: RGBi dodger_blue4 :: RGBi firebrick1 :: RGBi firebrick2 :: RGBi firebrick3 :: RGBi firebrick4 :: RGBi gold1 :: RGBi gold2 :: RGBi gold3 :: RGBi gold4 :: RGBi goldenrod1 :: RGBi goldenrod2 :: RGBi goldenrod3 :: RGBi goldenrod4 :: RGBi green1 :: RGBi green2 :: RGBi green3 :: RGBi green4 :: RGBi honeydew1 :: RGBi honeydew2 :: RGBi honeydew3 :: RGBi honeydew4 :: RGBi hot_pink1 :: RGBi hot_pink2 :: RGBi hot_pink3 :: RGBi hot_pink4 :: RGBi indian_red1 :: RGBi indian_red2 :: RGBi indian_red3 :: RGBi indian_red4 :: RGBi ivory1 :: RGBi ivory2 :: RGBi ivory3 :: RGBi ivory4 :: RGBi khaki1 :: RGBi khaki2 :: RGBi khaki3 :: RGBi khaki4 :: RGBi lavender_blush1 :: RGBi lavender_blush2 :: RGBi lavender_blush3 :: RGBi lavender_blush4 :: RGBi lemon_chiffon1 :: RGBi lemon_chiffon2 :: RGBi lemon_chiffon3 :: RGBi lemon_chiffon4 :: RGBi light_blue1 :: RGBi light_blue2 :: RGBi light_blue3 :: RGBi light_blue4 :: RGBi light_cyan1 :: RGBi light_cyan2 :: RGBi light_cyan3 :: RGBi light_cyan4 :: RGBi light_goldenrod1 :: RGBi light_goldenrod2 :: RGBi light_goldenrod3 :: RGBi light_goldenrod4 :: RGBi light_pink1 :: RGBi light_pink2 :: RGBi light_pink3 :: RGBi light_pink4 :: RGBi light_salmon1 :: RGBi light_salmon2 :: RGBi light_salmon3 :: RGBi light_salmon4 :: RGBi light_sky_blue1 :: RGBi light_sky_blue2 :: RGBi light_sky_blue3 :: RGBi light_sky_blue4 :: RGBi light_steel_blue1 :: RGBi light_steel_blue2 :: RGBi light_steel_blue3 :: RGBi light_steel_blue4 :: RGBi light_yellow1 :: RGBi light_yellow2 :: RGBi light_yellow3 :: RGBi light_yellow4 :: RGBi magenta1 :: RGBi magenta2 :: RGBi magenta3 :: RGBi magenta4 :: RGBi maroon1 :: RGBi maroon2 :: RGBi maroon3 :: RGBi maroon4 :: RGBi medium_orchid1 :: RGBi medium_orchid2 :: RGBi medium_orchid3 :: RGBi medium_orchid4 :: RGBi medium_purple1 :: RGBi medium_purple2 :: RGBi medium_purple3 :: RGBi medium_purple4 :: RGBi misty_rose1 :: RGBi misty_rose2 :: RGBi misty_rose3 :: RGBi misty_rose4 :: RGBi navajo_white1 :: RGBi navajo_white2 :: RGBi navajo_white3 :: RGBi navajo_white4 :: RGBi olive_drab1 :: RGBi olive_drab2 :: RGBi olive_drab3 :: RGBi olive_drab4 :: RGBi orange1 :: RGBi orange2 :: RGBi orange3 :: RGBi orange4 :: RGBi orange_red1 :: RGBi orange_red2 :: RGBi orange_red3 :: RGBi orange_red4 :: RGBi orchid1 :: RGBi orchid2 :: RGBi orchid3 :: RGBi orchid4 :: RGBi pale_green1 :: RGBi pale_green2 :: RGBi pale_green3 :: RGBi pale_green4 :: RGBi pale_turquoise1 :: RGBi pale_turquoise2 :: RGBi pale_turquoise3 :: RGBi pale_turquoise4 :: RGBi pale_violet_red1 :: RGBi pale_violet_red2 :: RGBi pale_violet_red3 :: RGBi pale_violet_red4 :: RGBi peach_puff1 :: RGBi peach_puff2 :: RGBi peach_puff3 :: RGBi peach_puff4 :: RGBi pink1 :: RGBi pink2 :: RGBi pink3 :: RGBi pink4 :: RGBi plum1 :: RGBi plum2 :: RGBi plum3 :: RGBi plum4 :: RGBi purple1 :: RGBi purple2 :: RGBi purple3 :: RGBi purple4 :: RGBi red1 :: RGBi red2 :: RGBi red3 :: RGBi red4 :: RGBi rosy_brown1 :: RGBi rosy_brown2 :: RGBi rosy_brown3 :: RGBi rosy_brown4 :: RGBi royal_blue1 :: RGBi royal_blue2 :: RGBi royal_blue3 :: RGBi royal_blue4 :: RGBi salmon1 :: RGBi salmon2 :: RGBi salmon3 :: RGBi salmon4 :: RGBi sea_green1 :: RGBi sea_green2 :: RGBi sea_green3 :: RGBi sea_green4 :: RGBi seashell1 :: RGBi seashell2 :: RGBi seashell3 :: RGBi seashell4 :: RGBi sienna1 :: RGBi sienna2 :: RGBi sienna3 :: RGBi sienna4 :: RGBi sky_blue1 :: RGBi sky_blue2 :: RGBi sky_blue3 :: RGBi sky_blue4 :: RGBi slate_blue1 :: RGBi slate_blue2 :: RGBi slate_blue3 :: RGBi slate_blue4 :: RGBi slate_gray1 :: RGBi slate_gray2 :: RGBi slate_gray3 :: RGBi slate_gray4 :: RGBi snow1 :: RGBi snow2 :: RGBi snow3 :: RGBi snow4 :: RGBi spring_green1 :: RGBi spring_green2 :: RGBi spring_green3 :: RGBi spring_green4 :: RGBi steel_blue1 :: RGBi steel_blue2 :: RGBi steel_blue3 :: RGBi steel_blue4 :: RGBi tan1 :: RGBi tan2 :: RGBi tan3 :: RGBi tan4 :: RGBi thistle1 :: RGBi thistle2 :: RGBi thistle3 :: RGBi thistle4 :: RGBi tomato1 :: RGBi tomato2 :: RGBi tomato3 :: RGBi tomato4 :: RGBi turquoise1 :: RGBi turquoise2 :: RGBi turquoise3 :: RGBi turquoise4 :: RGBi violet_red1 :: RGBi violet_red2 :: RGBi violet_red3 :: RGBi violet_red4 :: RGBi wheat1 :: RGBi wheat2 :: RGBi wheat3 :: RGBi wheat4 :: RGBi yellow1 :: RGBi yellow2 :: RGBi yellow3 :: RGBi yellow4 :: RGBi -- | The SVG 'named colours', as rgb [0,1] values module Wumpus.Drawing.Colour.SVGColours alice_blue :: RGBi antique_white :: RGBi aqua :: RGBi aquamarine :: RGBi azure :: RGBi beige :: RGBi bisque :: RGBi black :: RGBi blanched_almond :: RGBi blue :: RGBi blue_violet :: RGBi brown :: RGBi burlywood :: RGBi cadet_blue :: RGBi chartreuse :: RGBi chocolate :: RGBi coral :: RGBi cornflower_blue :: RGBi cornsilk :: RGBi crimson :: RGBi cyan :: RGBi dark_blue :: RGBi dark_cyan :: RGBi dark_goldenrod :: RGBi dark_gray :: RGBi dark_green :: RGBi dark_grey :: RGBi dark_khaki :: RGBi dark_magenta :: RGBi dark_olive_green :: RGBi dark_orange :: RGBi dark_orchid :: RGBi dark_red :: RGBi dark_salmon :: RGBi dark_sea_green :: RGBi dark_slate_blue :: RGBi dark_slate_gray :: RGBi dark_slate_grey :: RGBi dark_turquoise :: RGBi dark_violet :: RGBi deep_pink :: RGBi deep_sky_blue :: RGBi dim_gray :: RGBi dim_grey :: RGBi dodger_blue :: RGBi firebrick :: RGBi floral_white :: RGBi forest_green :: RGBi fuchsia :: RGBi gainsboro :: RGBi ghost_white :: RGBi gold :: RGBi goldenrod :: RGBi gray :: RGBi grey :: RGBi green :: RGBi green_yellow :: RGBi honeydew :: RGBi hot_pink :: RGBi indian_red :: RGBi indigo :: RGBi ivory :: RGBi khaki :: RGBi lavender :: RGBi lavender_blush :: RGBi lawn_green :: RGBi lemon_chiffon :: RGBi light_blue :: RGBi light_coral :: RGBi light_cyan :: RGBi light_goldenrod_yellow :: RGBi light_gray :: RGBi light_green :: RGBi light_grey :: RGBi light_pink :: RGBi light_salmon :: RGBi light_sea_green :: RGBi light_sky_blue :: RGBi light_slate_gray :: RGBi light_slate_grey :: RGBi light_steel_blue :: RGBi light_yellow :: RGBi lime :: RGBi lime_green :: RGBi linen :: RGBi magenta :: RGBi maroon :: RGBi medium_aquamarine :: RGBi medium_blue :: RGBi medium_orchid :: RGBi medium_purple :: RGBi medium_sea_green :: RGBi medium_slate_blue :: RGBi medium_spring_green :: RGBi medium_turquoise :: RGBi medium_violet_red :: RGBi midnight_blue :: RGBi mintcream :: RGBi mistyrose :: RGBi moccasin :: RGBi navajo_white :: RGBi navy :: RGBi old_lace :: RGBi olive :: RGBi olive_drab :: RGBi orange :: RGBi orange_red :: RGBi orchid :: RGBi pale_goldenrod :: RGBi pale_green :: RGBi pale_turquoise :: RGBi pale_violet_red :: RGBi papaya_whip :: RGBi peach_puff :: RGBi peru :: RGBi pink :: RGBi plum :: RGBi powder_blue :: RGBi purple :: RGBi red :: RGBi rosy_brown :: RGBi royal_blue :: RGBi saddle_brown :: RGBi salmon :: RGBi sandy_brown :: RGBi sea_green :: RGBi seashell :: RGBi sienna :: RGBi silver :: RGBi sky_blue :: RGBi slate_blue :: RGBi slate_gray :: RGBi slate_grey :: RGBi snow :: RGBi spring_green :: RGBi steel_blue :: RGBi tan :: RGBi teal :: RGBi thistle :: RGBi tomato :: RGBi turquoise :: RGBi violet :: RGBi wheat :: RGBi white :: RGBi whitesmoke :: RGBi yellow :: RGBi yellow_green :: RGBi -- | Version number module Wumpus.Basic.VersionNumber -- | Version number -- -- 
--   (0,14,0)
--
wumpus_basic_version :: (Int, Int, Int) -- | 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 -- | Build paths monadically. -- -- ** WARNING ** this module is an experiment, and may change -- significantly or even be dropped from future revisions. module Wumpus.Drawing.Paths.Construction data PathM u a runPath :: Floating u => Point2 u -> PathM u a -> (a, Path u) execPath :: Floating u => Point2 u -> PathM u a -> Path u tip :: PathM u (Point2 u) lineto :: Floating u => Point2 u -> PathM u () rlineto :: Floating u => Vec2 u -> PathM u () hline :: Floating u => u -> PathM u () vline :: Floating u => u -> PathM u () bezierto :: (Floating u, Ord u) => Point2 u -> Point2 u -> Point2 u -> PathM u () curveto :: (Floating u, Ord u) => Radian -> Radian -> Point2 u -> PathM u () verticalHorizontal :: Floating u => Point2 u -> PathM u () horizontalVertical :: Floating u => Point2 u -> PathM u () instance Monad (PathM u) instance Applicative (PathM u) instance Functor (PathM u) -- | Paths for elementary shapes - rectangles... -- -- ** - WARNING ** - half baked. module Wumpus.Basic.Kernel.Geometry.Paths -- | Supplied point is bottom-left. rectanglePath :: Num u => u -> u -> Point2 u -> PrimPath u -- | diamondPath : half_width * half_height * center_point -- -> PrimPath diamondPath :: Num u => u -> u -> Point2 u -> PrimPath u -- | polygonPoints : num_points * radius * center -> [point] -- polygonPoints :: Floating u => Int -> u -> Point2 u -> [Point2 u] -- | 
--   isocelesTriangle bw h pt
--
-- -- Supplied point is the centriod of the triangle. This has a nicer -- visual balance than using half-height. isoscelesTrianglePath :: Floating u => u -> u -> Point2 u -> PrimPath 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) equilateralTrianglePath :: Floating u => u -> Point2 u -> PrimPath u equilateralTrianglePoints :: Floating u => u -> Point2 u -> (Point2 u, Point2 u, Point2 u) -- | Intersection of line to line and line to plane -- -- ** - WARNING ** - half baked. module Wumpus.Basic.Kernel.Geometry.Intersection data LineSegment u LS :: (Point2 u) -> (Point2 u) -> LineSegment u data PointSlope u pointSlope :: Fractional u => Point2 u -> Radian -> PointSlope u -- | Line in equational form, i.e. Ax + By + C = 0. data LineEqn u lineEqn :: Num u => Point2 u -> Point2 u -> LineEqn u toLineEqn :: Num u => PointSlope u -> LineEqn u findIntersect :: (Floating u, Real u, Ord u) => Point2 u -> Radian -> [LineSegment u] -> Maybe (Point2 u) intersection :: (Fractional u, Ord u) => LineSegment u -> LineEqn u -> Maybe (Point2 u) rectangleLines :: Num u => Point2 u -> u -> u -> [LineSegment u] polygonLines :: [Point2 u] -> [LineSegment u] -- | Calculate the counter-clockwise angle between two points and the -- x-axis. langle :: (Floating u, Real u) => Point2 u -> Point2 u -> Radian instance Eq u => Eq (IntersectionResult u) instance Show u => Show (IntersectionResult u) instance Eq u => Eq (LineEqn u) instance Show u => Show (LineEqn u) instance Eq u => Eq (PointSlope u) instance Show u => Show (PointSlope u) instance Eq u => Eq (LineSegment u) instance Ord u => Ord (LineSegment u) instance Show u => Show (LineSegment 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) -> 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 -- | MetricsOps tfor 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 -> [AfmGlyphMetrics] -> AfmFile afm_encoding :: AfmFile -> Maybe String afm_letter_bbox :: AfmFile -> Maybe AfmBoundingBox afm_cap_height :: 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 -> Vec2 cu -> MonospaceDefaults cu default_letter_bbox :: MonospaceDefaults cu -> BoundingBox cu default_cap_height :: 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 -> 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 -- | 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 ** - 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.DrawingContext data DrawingContext DrawingContext :: GlyphMetrics -> MetricsOps -> StrokeAttr -> FontAttr -> RGBi -> RGBi -> Double -> 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 type DrawingContextF = DrawingContext -> DrawingContext 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. 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 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 glyphBoundingBox :: (FromPtSize u, DrawingCtxM m) => m (BoundingBox u) glyphHeightRange :: (FromPtSize u, DrawingCtxM m) => m (u, u) glyphHeight :: (FromPtSize u, DrawingCtxM m) => m u glyphCapHeight :: (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 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- direction of the implicit angle by the supplied distance -- dist. displacePerpendicular :: Floating u => u -> ThetaPointDisplace 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 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 OPlus a => OPlus (r -> a) 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 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) -- | 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) -- | Scaling in X and Y -- -- ** WARNING ** - half baked. module Wumpus.Basic.Kernel.Base.ScalingContext -- | Scaling... class Monad m => ScalingM m where { type family XDim m :: *; type family YDim m :: *; } scaleX :: (ScalingM m, u ~ (MonUnit m), ux ~ (XDim m)) => ux -> m u scaleY :: (ScalingM m, u ~ (MonUnit m), uy ~ (YDim m)) => uy -> m u scalePt :: (ScalingM m, u ~ (MonUnit m), ux ~ (XDim m), uy ~ (YDim m)) => ux -> uy -> m (Point2 u) scaleVec :: (ScalingM m, u ~ (MonUnit m), ux ~ (XDim m), uy ~ (YDim m)) => ux -> uy -> m (Vec2 u) 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 data Scaling ux uy u a runScaling :: ScalingContext ux uy u -> Scaling ux uy u a -> a data ScalingT ux uy u m a runScalingT :: ScalingContext ux uy u -> ScalingT ux uy u m a -> m a regularScalingContext :: Num u => u -> ScalingContext u u u coordinateScalingContext :: Num u => u -> u -> ScalingContext Int Int u unitX :: (ScalingM m, Num ux, ux ~ (XDim m), u ~ (MonUnit m)) => m u unitY :: (ScalingM m, Num uy, uy ~ (YDim m), u ~ (MonUnit m)) => m u instance (u ~ MonUnit m, Monad m, TraceM m) => TraceM (ScalingT ux uy u m) instance DrawingCtxM m => DrawingCtxM (ScalingT ux uy u m) instance Monad m => ScalingM (ScalingT ux uy u m) instance Monad m => Monad (ScalingT ux uy u m) instance Monad m => Applicative (ScalingT ux uy u m) instance Monad m => Functor (ScalingT ux uy u m) instance ScalingM (Scaling ux uy u) instance Monad (Scaling ux uy u) instance Applicative (Scaling ux uy u) instance Functor (Scaling ux uy 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 hyperlink :: XLink -> Image u a -> Image u 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 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) 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 so the -- Points ar midway, atstart etc. can be taken on it. type ConnectorImage u a = ConnectorCF u (ImageAns u a) type DConnectorImage a = ConnectorImage Double 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 -- | Build an Image... intoImage :: CF a -> Graphic u -> Image u a -- | Build a LocImage... intoLocImage :: LocCF u a -> LocGraphic u -> LocImage u a -- | Build a LocThetaImage... intoLocThetaImage :: LocThetaCF u a -> LocThetaGraphic u -> LocThetaImage u a -- | Move the start-point of a LocImage with the supplied displacement -- function. moveStartPoint :: PointDisplace u -> LocCF u a -> LocCF u a -- | Move the start-point of a LocImage with the supplied displacement -- function. moveStartPointTheta :: PointDisplace u -> LocThetaCF u a -> LocThetaCF u a -- | This is the analogue to vectorPath in Wumpus-core. locPath :: Num u => [Vec2 u] -> LocCF u (PrimPath u) -- | This is the analogue to emptyPath in Wumpus-core. emptyLocPath :: Num u => LocCF u (PrimPath u) -- | Build an empty LocGraphic - this is a path with a start point but no -- path segments. -- -- The emptyLocGraphic It 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 -- | 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 -- | This is the analogue to textlabel in Wumpus-core. textline :: Num u => String -> LocGraphic u -- | This is the analogue to rtextlabel in Wumpus-core. rtextline :: Num u => String -> LocThetaGraphic u -- | This is the analogue to escapedlabel in Wumpus-core. escapedline :: Num u => EscapedText -> LocGraphic u -- | This is the analogue to rescapedlabel in Wumpus-core. rescapedline :: Num u => EscapedText -> LocThetaGraphic u -- | This is the analogue to hkernlabel in Wumpus-core. hkernline :: Num u => [KerningChar u] -> LocGraphic u -- | This is the analogue to vkernlabel in Wumpus-core. vkernline :: Num u => [KerningChar u] -> LocGraphic u -- | This is the analogue to strokeEllipse in Wumpus-core. strokedEllipse :: Num u => u -> u -> LocGraphic u -- | This is the analogue to rstrokeEllispe in -- Wumpus-core. rstrokedEllipse :: Num u => u -> u -> LocThetaGraphic u -- | This is the analogue to fillEllispe in Wumpus-core. filledEllipse :: Num u => u -> u -> LocGraphic u -- | This is the analogue to rfillEllispe in Wumpus-core. rfilledEllipse :: Num u => u -> u -> LocThetaGraphic u -- | This is the analogue to fillStrokeEllispe in -- Wumpus-core. borderedEllipse :: Num u => u -> u -> LocGraphic u -- | This is the analogue to rfillStrokeEllispe in -- Wumpus-core. rborderedEllipse :: Num u => u -> u -> LocThetaGraphic u -- | Draw a straight line formed from displacing the implicit start point -- with the supplied vector. straightLine :: Fractional u => Vec2 u -> LocGraphic u -- | Draw a straight line - start and end point are supplied explicitly. straightLineBetween :: Fractional u => Point2 u -> Point2 u -> Graphic u -- | Draw a Bezier curve - all points are supplied explicitly. curveBetween :: Fractional u => Point2 u -> Point2 u -> Point2 u -> Point2 u -> Graphic u -- | Supplied point is bottom left. strokedRectangle :: Fractional u => u -> u -> LocGraphic u -- | Supplied point is bottom left. filledRectangle :: Fractional u => u -> u -> LocGraphic u -- | Supplied point is bottom left. borderedRectangle :: Fractional u => u -> u -> LocGraphic u -- | Supplied point is center. Circle is drawn with Bezier curves. strokedCircle :: Floating u => Int -> u -> LocGraphic u -- | Supplied point is center. Circle is drawn with Bezier curves. filledCircle :: Floating u => Int -> u -> LocGraphic u -- | Supplied point is center. Circle is drawn with Bezier curves. borderedCircle :: Floating u => Int -> u -> LocGraphic u -- | disk is drawn with Wumpus-Core's ellipse primitive. -- -- 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 line width is scaled as well as the shape. -- -- For stroked circles that can be adequately scaled, use -- strokedCircle instead. strokedDisk :: Num u => u -> LocGraphic u -- | Filled disk... filledDisk :: Num u => u -> LocGraphic u -- | bordered disk... borderedDisk :: Num u => u -> LocGraphic u -- | Extended Graphic object - an AdvanceGraphic is a Graphic twinned with -- and AdvanceV vector. module Wumpus.Basic.Kernel.Objects.AdvanceGraphic -- | Advance vector graphic - this partially models the PostScript -- show command which moves the current point by the -- width (advance) vector as each character is drawn. type AdvGraphic u = LocImage u (Point2 u) type DAdvGraphic = AdvGraphic Double -- | Construction is different to intoZZ functions hence the different -- name. makeAdvGraphic :: DrawingInfo (PointDisplace u) -> LocGraphic u -> AdvGraphic u extractLocGraphic :: AdvGraphic u -> LocGraphic u runAdvGraphic :: DrawingContext -> Point2 u -> AdvGraphic u -> (Point2 u, PrimGraphic u) -- | ** WARNING ** - pending removal. advplus :: AdvGraphic u -> AdvGraphic u -> AdvGraphic u advconcat :: Num u => [AdvGraphic u] -> AdvGraphic 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 :: Num u => BoundedLocGraphic u -- | openStroke : 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 -- | 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. module Wumpus.Basic.Kernel.Base.Anchors -- | Center of an object. class CenterAnchor t center :: (CenterAnchor 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 problemmatic, 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 -- | northwards : dist * object -> Point -- -- Project the anchor along a line from the center that goes through the -- north anchor. -- -- If the distance is zero the answer with be the north anchor. -- -- If the distance is negative the answer within the object before the -- north anchor. -- -- If the distance is positive the anchor outside the object. northwards :: (Real u, Floating u, CenterAnchor t, CardinalAnchor t, u ~ (DUnit t)) => u -> t -> Point2 u -- | southwards : dist * object -> Point -- -- Variant of the function northwards, but projecting the line -- southwards from the center of the object. southwards :: (Real u, Floating u, CenterAnchor t, CardinalAnchor t, u ~ (DUnit t)) => u -> t -> Point2 u -- | eastwards : dist * object -> Point -- -- Variant of the function northwards, but projecting the line -- eastwards from the center of the object. eastwards :: (Real u, Floating u, CenterAnchor t, CardinalAnchor t, u ~ (DUnit t)) => u -> t -> Point2 u -- | westwards : dist * object -> Point -- -- Variant of the function northwards, but projecting the line -- westwards from the center of the object. westwards :: (Real u, Floating u, CenterAnchor t, CardinalAnchor t, u ~ (DUnit t)) => u -> t -> Point2 u -- | northeastwards : dist * object -> Point -- -- Variant of the function northwards, but projecting the line -- northeastwards from the center of the object. northeastwards :: (Real u, Floating u, CenterAnchor t, CardinalAnchor2 t, u ~ (DUnit t)) => u -> t -> Point2 u -- | southeastwards : dist * object -> Point -- -- Variant of the function northwards, but projecting the line -- southeastwards from the center of the object. southeastwards :: (Real u, Floating u, CenterAnchor t, CardinalAnchor2 t, u ~ (DUnit t)) => u -> t -> Point2 u -- | southwestwards : dist * object -> Point -- -- Variant of the function northwards, but projecting the line -- southwestwards from the center of the object. southwestwards :: (Real u, Floating u, CenterAnchor t, CardinalAnchor2 t, u ~ (DUnit t)) => u -> t -> Point2 u -- | northwestwards : dist * object -> Point -- -- Variant of the function northwards, but projecting the line -- northwestwards from the center of the object. northwestwards :: (Real u, Floating u, CenterAnchor t, CardinalAnchor2 t, u ~ (DUnit t)) => 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 Drawing object. -- -- This is the corresponding type to Picture in the Wumpus-Core. -- -- Drawing is a function from the DrawingContext to a 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). module Wumpus.Basic.Kernel.Objects.Drawing data Drawing u type DDrawing = Drawing Double runDrawing :: DrawingContext -> Drawing u -> Maybe (Picture u) runDrawingU :: DrawingContext -> Drawing u -> Picture u drawTracing :: (Real u, Floating u, FromPtSize u) => TraceDrawing u a -> Drawing u clipDrawing :: (Num u, Ord u) => (PrimPath u) -> Drawing u -> Drawing u modifyDrawing :: (Picture u -> Picture u) -> Drawing u -> Drawing u -- | 
--   a `over` b
--
-- -- Place 'drawing' a over b. The idea of over here is in terms -- z-ordering, nither picture a or b are actually moved. over :: (Num u, Ord u) => Drawing u -> Drawing u -> Drawing u -- | 
--   a `under` b
--
-- -- Similarly under draws the first drawing behind the second but -- move neither. under :: (Num u, Ord u) => Drawing u -> Drawing u -> Drawing u -- | Draw a, move b so its center is at the same center -- as a, b is drawn over underneath in the zorder. -- -- 
--   a `centeric` b 
--
centric :: (Fractional u, Ord u) => Drawing u -> Drawing u -> Drawing u -- | 
--   a `nextToH` b
--
-- -- Horizontal composition - move b, placing it to the right of -- a. nextToH :: (Num u, Ord u) => Drawing u -> Drawing u -> Drawing u -- | 
--   a `nextToV` b
--
-- -- Vertical composition - move b, placing it below a. nextToV :: (Num u, Ord u) => Drawing u -> Drawing u -> Drawing u -- | Place the picture at the supplied point. -- -- atPoint was previous the at operator. atPoint :: (Num u, Ord u) => Drawing u -> Point2 u -> Drawing u -- | Center the picture at the supplied point. centeredAt :: (Fractional u, Ord u) => Drawing u -> Point2 u -> Drawing u -- | Concatenate the list of drawings. -- -- No pictures are moved. zconcat :: (Real u, Floating u, FromPtSize u) => [Drawing u] -> Drawing u -- | Concatenate the list pictures xs horizontally. hcat :: (Real u, Floating u, FromPtSize u) => [Drawing u] -> Drawing u -- | Concatenate the list of pictures xs vertically. vcat :: (Real u, Floating u, FromPtSize u) => [Drawing u] -> Drawing u -- | 
--   hspace n a b
--
-- -- Horizontal composition - move b, placing it to the right of -- a with a horizontal gap of n separating the -- pictures. hspace :: (Num u, Ord u) => u -> Drawing u -> Drawing u -> Drawing u -- | 
--   vspace n a b
--
-- -- Vertical composition - move b, placing it below a -- with a vertical gap of n separating the pictures. vspace :: (Num u, Ord u) => u -> Drawing u -> Drawing u -> Drawing u -- | 
--   hsep n xs
--
-- -- Concatenate the list of pictures xs horizontally with -- hspace starting at x. The pictures are interspersed -- with spaces of n units. hsep :: (Real u, Floating u, FromPtSize u) => u -> [Drawing u] -> Drawing u -- | 
--   vsep n xs
--
-- -- Concatenate the list of pictures xs vertically with -- vspace starting at x. The pictures are interspersed -- with spaces of n units. vsep :: (Real u, Floating u, FromPtSize u) => u -> [Drawing u] -> Drawing u -- | 
--   alignH 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. alignH :: (Fractional u, Ord u) => HAlign -> Drawing u -> Drawing u -> Drawing u -- | 
--   alignV align a b
--
-- -- Vertical composition - move b, placing it below a -- and align it with the left, center or right of a. alignV :: (Fractional u, Ord u) => VAlign -> Drawing u -> Drawing u -> Drawing u -- | 
--   alignHSep align sep a b
--
-- -- Spacing version of alignH - move b to the right of a -- separated by sep units, align b according to -- align. alignHSep :: (Fractional u, Ord u) => HAlign -> u -> Drawing u -> Drawing u -> Drawing u -- | 
--   alignVSep align sep a b
--
-- -- Spacing version of alignV - move b below a separated -- by sep units, align b according to align. alignVSep :: (Fractional u, Ord u) => VAlign -> u -> Drawing u -> Drawing u -> Drawing u -- | Variant of hcat that aligns the pictures as well as -- concatenating them. hcatA :: (Real u, Floating u, FromPtSize u) => HAlign -> [Drawing u] -> Drawing u -- | Variant of vcat that aligns the pictures as well as -- concatenating them. vcatA :: (Real u, Floating u, FromPtSize u) => VAlign -> [Drawing u] -> Drawing u -- | Variant of hsep that aligns the pictures as well as -- concatenating and spacing them. hsepA :: (Real u, Floating u, FromPtSize u) => HAlign -> u -> [Drawing u] -> Drawing u -- | Variant of vsep that aligns the pictures as well as -- concatenating and spacing them. vsepA :: (Real u, Floating u, FromPtSize u) => VAlign -> u -> [Drawing u] -> Drawing u instance (Num u, Ord u) => Translate (Drawing u) instance (Num u, Ord u) => Scale (Drawing u) instance (Real u, Floating u) => RotateAbout (Drawing u) instance (Real u, Floating u) => Rotate (Drawing 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]) -- | Generate points in an iterated chain. -- -- WARNING - very unstable. module Wumpus.Drawing.Chains.Base data Chain ux uy u type LocChain ux uy u = Point2 u -> Chain ux uy u chain :: BivariateAlg ux uy -> Chain ux uy u chainFrom :: Num u => BivariateAlg ux uy -> LocChain ux uy u unchain :: ScalingContext ux uy u -> Chain ux uy u -> [Point2 u] -- | Chains are built as unfolds - AnaAlg avoids the pair constructor in -- the usual definition of unfoldr and makes the state strict. -- -- It is expected that all Chains built on unfolds will terminate. data AnaAlg st a Done :: AnaAlg st a Step :: a -> !st -> AnaAlg st a -- | IterAlg is a variant of AnaAlg that builds infinite sequences -- (iterations). -- -- When lifted to a Chain an iteration is bounded by a count so it will -- terminate. data IterAlg st a IterStep :: a -> !st -> IterAlg st a data BivariateAlg ux uy bivariate :: st -> (st -> AnaAlg st (ux, uy)) -> BivariateAlg ux uy data SequenceAlg a iteration :: (a -> a) -> a -> SequenceAlg a bounded :: Int -> SequenceAlg (ux, uy) -> BivariateAlg ux uy pairOnXs :: (ux -> uy) -> SequenceAlg ux -> SequenceAlg (ux, uy) pairOnYs :: (r -> l) -> SequenceAlg r -> SequenceAlg (l, r) -- | Generate points in an iterated chain. -- -- WARNING - very unstable. module Wumpus.Drawing.Chains.Derived univariateX :: (Fractional uy, Num ux, Num u) => [ux] -> LocChain ux uy u univariateY :: (Fractional ux, Num uy, Num u) => [uy] -> LocChain ux uy u tableDown :: Int -> Int -> Chain Int Int u tableRight :: Num u => Int -> Int -> Chain Int Int u horizontal :: Int -> Chain Int Int u vertical :: Int -> Chain Int Int u horizontals :: (Num ua, Num u) => [ua] -> LocChain ua ua u verticals :: (Num ua, Num u) => [ua] -> LocChain ua ua u rescale :: Fractional a => a -> a -> a -> a -> a -> a -- | Shim module. -- -- WARNING - very unstable. module Wumpus.Drawing.Chains -- | Left-to-right measured text. The text uses glyph metrics so it can be -- positioned accurately. -- -- ** WARNING ** - the API for this module has not been decided. The -- function names are expected to change. module Wumpus.Drawing.Text.LRText -- | Draw 1 line... -- -- Impilict point is baseline-center. baseCenterLine :: (Real u, Floating u, FromPtSize u) => String -> BoundedLocGraphic u -- | Draw 1 line... -- -- Impilict point is baseline-left. baseLeftLine :: (Real u, Floating u, FromPtSize u) => String -> BoundedLocGraphic u -- | Draw 1 line... -- -- Impilict point is baseline-right. baseRightLine :: (Real u, Floating u, FromPtSize u) => String -> BoundedLocGraphic u rbaseCenterLine :: (Real u, Floating u, FromPtSize u) => String -> BoundedLocThetaGraphic u rbaseLeftLine :: (Real u, Floating u, FromPtSize u) => String -> BoundedLocThetaGraphic u rbaseRightLine :: (Real u, Floating u, FromPtSize u) => String -> BoundedLocThetaGraphic u ctrCenterLine :: (Real u, Floating u, FromPtSize u) => String -> BoundedLocGraphic u baseCenterEscChar :: (Real u, Floating u, FromPtSize u) => EscapedChar -> BoundedLocGraphic u multiAlignLeft :: (Floating u, Real u, Ord u, FromPtSize u) => String -> BoundedLocGraphic u multiAlignCenter :: (Floating u, Real u, Ord u, FromPtSize u) => String -> BoundedLocGraphic u multiAlignRight :: (Floating u, Real u, Ord u, FromPtSize u) => String -> BoundedLocGraphic u rmultiAlignLeft :: (Floating u, Real u, Ord u, FromPtSize u) => String -> BoundedLocThetaGraphic u rmultiAlignCenter :: (Floating u, Real u, Ord u, FromPtSize u) => String -> BoundedLocThetaGraphic u rmultiAlignRight :: (Floating u, Real u, Ord u, FromPtSize u) => String -> BoundedLocThetaGraphic u -- | Marks - dots without anchor handles. -- -- The text and char marks need loaded glyph metrics for proper -- centering. -- -- ** WARNING ** - names are expected to change - filled and -- background-filled marks need a naming convention. module Wumpus.Drawing.Dots.Marks markChar :: (Real u, Floating u, FromPtSize u) => Char -> LocGraphic u markText :: (Real u, Floating u, FromPtSize u) => String -> LocGraphic u markHLine :: (Fractional u, FromPtSize u) => LocGraphic u markVLine :: (Fractional u, FromPtSize u) => LocGraphic u markX :: (Fractional u, FromPtSize u) => LocGraphic u markPlus :: (Fractional u, FromPtSize u) => LocGraphic u markCross :: (Floating u, FromPtSize u) => LocGraphic u markDiamond :: (Fractional u, FromPtSize u) => LocGraphic u markFDiamond :: (Fractional u, FromPtSize u) => LocGraphic u markBDiamond :: (Fractional u, FromPtSize u) => LocGraphic u -- | Note disk is filled. markDisk :: (Fractional u, FromPtSize u) => LocGraphic u markSquare :: (Fractional u, FromPtSize u) => LocGraphic u markCircle :: (Fractional u, FromPtSize u) => LocGraphic u markPentagon :: (Floating u, FromPtSize u) => LocGraphic u markStar :: (Floating u, FromPtSize u) => LocGraphic u markAsterisk :: (Floating u, FromPtSize u) => LocGraphic u markOPlus :: (Fractional u, FromPtSize u) => LocGraphic u markOCross :: (Floating u, FromPtSize u) => LocGraphic u markFOCross :: (Floating u, FromPtSize u) => LocGraphic u markTriangle :: (Floating u, FromPtSize u) => LocGraphic u -- | Dots with anchors. -- -- In many cases a surrounding circle is used to locate anchor points - -- this could be improved to use the actual dot border at some point. module Wumpus.Drawing.Dots.AnchorDots data DotAnchor u type DotLocImage u = LocImage u (DotAnchor u) type DDotLocImage = DotLocImage Double dotChar :: (Floating u, Real u, FromPtSize u) => Char -> DotLocImage u -- | Note - dotText now uses font metrics... dotText :: (Floating u, Real u, FromPtSize u) => String -> DotLocImage u dotHLine :: (Floating u, FromPtSize u) => DotLocImage u dotVLine :: (Floating u, FromPtSize u) => DotLocImage u dotX :: (Floating u, FromPtSize u) => DotLocImage u dotPlus :: (Floating u, FromPtSize u) => DotLocImage u dotCross :: (Floating u, FromPtSize u) => DotLocImage u dotDiamond :: (Floating u, FromPtSize u) => DotLocImage u dotFDiamond :: (Floating u, FromPtSize u) => DotLocImage u dotDisk :: (Floating u, FromPtSize u) => DotLocImage u dotSquare :: (Floating u, Real u, FromPtSize u) => DotLocImage u dotCircle :: (Floating u, FromPtSize u) => DotLocImage u dotPentagon :: (Floating u, FromPtSize u) => DotLocImage u dotStar :: (Floating u, FromPtSize u) => DotLocImage u dotAsterisk :: (Floating u, FromPtSize u) => DotLocImage u dotOPlus :: (Floating u, FromPtSize u) => DotLocImage u dotOCross :: (Floating u, FromPtSize u) => DotLocImage u dotFOCross :: (Floating u, FromPtSize u) => DotLocImage u dotTriangle :: (Real u, Floating u, FromPtSize u) => DotLocImage u instance Eq Cardinal instance Show Cardinal instance CardinalAnchor2 (DotAnchor u) instance CardinalAnchor (DotAnchor u) instance RadialAnchor (DotAnchor u) instance CenterAnchor (DotAnchor u) -- | Collection of point manufacturing functions. -- -- ** WARNING ** this module is experimental and may change significantly -- in future revisions. module Wumpus.Drawing.Paths.ControlPoints -- | midpointIsosceles : altitude * start_pt * end_pt -> -- mid_pt -- -- Triangular midpoint. -- -- u is the altitude of the triangle - negative values of u form -- the triangle below the line. midpointIsosceles :: (Real u, Floating u) => u -> Point2 u -> Point2 u -> Point2 u -- | dblpointIsosceles : altitude * start_pt * end_pt * -- (third_pt, two_thirds_pt) -- -- Double triangular joint - one joint at a third of the line length, the -- other at two thirds. dblpointIsosceles :: (Real u, Floating u) => u -> Point2 u -> Point2 u -> (Point2 u, Point2 u) -- | rectangleFromBasePoints : altitude * start_pt * end_pt * -- (top_left, top_right) -- -- Control points forming a rectangle. -- -- The two manufactured control points form the top corners, so the -- supplied points map as start_point == bottom_left and -- end_point == bottom_right. rectangleFromBasePoints :: (Real u, Floating u) => u -> Point2 u -> Point2 u -> (Point2 u, Point2 u) -- | squareFromBasePoints : start_pt -> end_pt -> -- (top_left, top_right) -- -- Control points forming a square - side_len derived from the distance -- between start and end points. -- -- The two manufactured control points form the top corners, so the -- supplied points map as start_point == bottom_left and -- end_point == bottom_right. squareFromBasePoints :: (Real u, Floating u) => Point2 u -> Point2 u -> (Point2 u, Point2 u) -- | usquareFromBasePoints : start_pt -> end_pt -> -- (bottom_left, bottom_right) -- -- Control points forming a square - side_len derived from the distance -- between start and end points. -- -- As per squareFromBasePoints but the square is drawn -- underneath the line formed between the start and end points. -- (Underneath is modulo the direction, of course). -- -- The two manufactured control points form the bottom corners, so -- the supplied points map as start_point == top_left and -- end_point == top_right. usquareFromBasePoints :: (Real u, Floating u) => Point2 u -> Point2 u -> (Point2 u, Point2 u) -- | trapezoidFromBasePoints : altitude * ratio_to_base * -- start_pt * end_pt -> (top_left, top_right) -- -- Control points form an isosceles trapezoid. -- -- The two manufactured control points form the top corners, so the -- supplied points map as start_point == bottom_left and -- end_point == bottom_right. trapezoidFromBasePoints :: (Real u, Floating u) => u -> u -> Point2 u -> Point2 u -> (Point2 u, Point2 u) -- | squareFromCornerPoints : altitude * start_pt * end_pt * -- (top_left, bottom_right) -- -- Control points forming a square bisected by the line from start_pt to -- end_pt. -- -- The two manufactured control points form the top_left and bottom_right -- corners, so the supplied points map as start_point == -- bottom_left and end_point == top_right. squareFromCornerPoints :: (Real u, Floating u) => Point2 u -> Point2 u -> (Point2 u, Point2 u) -- | Library of connector paths... -- -- ** WARNING ** this module is experimental and may change significantly -- in future revisions. module Wumpus.Drawing.Paths.Connectors type ConnectorPath u = Point2 u -> Point2 u -> Path u type DConnectorPath = ConnectorPath Double -- | Connect with a straight line. connLine :: Floating u => ConnectorPath u -- | Right-angled connector - go vertical, then go horizontal. connRightVH :: Floating u => ConnectorPath u -- | Right-angled connector - go horizontal, then go vertical. connRightHV :: Floating u => ConnectorPath u -- | Right-angled connector - go vertical for the supplied distance, go -- horizontal, go vertical again for the remaining distance. connRightVHV :: Floating u => u -> ConnectorPath u -- | Right-angled connector - go horizontal for the supplied distance, go -- verical, go horizontal again for the remaining distance. connRightHVH :: Floating u => u -> ConnectorPath u -- | Triangular joint. -- -- u is the altitude of the triangle. connIsosceles :: (Real u, Floating u) => u -> ConnectorPath u -- | Double triangular joint. -- -- u is the altitude of the triangle. connIsosceles2 :: (Real u, Floating u) => u -> ConnectorPath u -- | Lightning bolt joint - a two joint connector with an -- axis perpendicular to the connector direction. -- -- u is the half length of the of the axis. connLightningBolt :: (Real u, Floating u) => u -> ConnectorPath u -- | Form a curve inside an isosceles triangle. -- -- The two Bezier control points take the same point - the altitude of -- the triangle. The curve tends to be quite shallow relative to the -- altitude. -- -- u is the altitude of the triangle. connIsoscelesCurve :: (Real u, Floating u) => u -> ConnectorPath u -- | Form a curve inside a square. -- -- The two Bezier control points take the top corners. The curve -- tends to be very deep. connSquareCurve :: (Real u, Floating u) => ConnectorPath u -- | Form a curve inside a square. -- -- As per connSquareCurve but the curve is drawn underneath -- the line formed between the start and end points. -- -- (Underneath is modulo the direction, of course). connUSquareCurve :: (Real u, Floating u) => ConnectorPath u -- | altitude * ratio_to_base -- -- Form a curve inside a trapeziod. connTrapezoidCurve :: (Real u, Floating u) => u -> u -> ConnectorPath u -- | Make a curve within a square, following the corner points as a Z. connZSquareCurve :: (Real u, Floating u) => ConnectorPath u -- | Make a curve within a square, following the corner points as a Z. -- -- The order of tracing flips the control points, so this is an -- underneath version of connZSquareCurve. connUZSquareCurve :: (Real u, Floating u) => ConnectorPath u -- | Shim import module for Paths. module Wumpus.Drawing.Paths -- | Anchor points on shapes. -- -- ** WARNING ** this module is an experiment, and may change -- significantly in future revisions. module Wumpus.Drawing.Arrows.Tips -- | Encode an arrowhead as an image where the answer is the retract -- distance. -- -- The retract distance is context sensitive - usually just on the -- markHeight (or halfMarkHeight) so it has to be calculated w.r.t. the -- DrawingCtx. newtype Arrowhead u Arrowhead :: LocThetaImage u u -> Arrowhead u getArrowhead :: Arrowhead u -> LocThetaImage u u tri90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u tri60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u tri45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u otri90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u otri60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u otri45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u revtri90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u revtri60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u revtri45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u orevtri90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u orevtri60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u orevtri45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u barb90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u barb60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u barb45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u revbarb90 :: (Floating u, Real u, FromPtSize u) => Arrowhead u revbarb60 :: (Floating u, Real u, FromPtSize u) => Arrowhead u revbarb45 :: (Floating u, Real u, FromPtSize u) => Arrowhead u perp :: (Floating u, FromPtSize u) => Arrowhead u bracket :: (Floating u, FromPtSize u) => Arrowhead u diskTip :: (Floating u, FromPtSize u) => Arrowhead u odiskTip :: (Floating u, FromPtSize u) => Arrowhead u squareTip :: (Floating u, FromPtSize u) => Arrowhead u osquareTip :: (Floating u, FromPtSize u) => Arrowhead u diamondTip :: (Floating u, FromPtSize u) => Arrowhead u odiamondTip :: (Floating u, FromPtSize u) => Arrowhead u curveTip :: (Real u, Floating u, FromPtSize u) => Arrowhead u revcurveTip :: (Real u, Floating u, FromPtSize u) => Arrowhead u -- | Draw arrows. module Wumpus.Drawing.Arrows.Connectors data Connector u -- | connector with no arrow heads. connector :: ConnectorPath u -> Connector u leftArrow :: ConnectorPath u -> Arrowhead u -> Connector u rightArrow :: ConnectorPath u -> Arrowhead u -> Connector u -- | Same tip both ends. dblArrow :: ConnectorPath u -> Arrowhead u -> Connector u leftrightArrow :: ConnectorPath u -> Arrowhead u -> Arrowhead u -> Connector u strokeConnector :: (Real u, Floating u) => Connector u -> ConnectorImage u (Path u) -- | Shim module for arrow connectors and arrowheads. module Wumpus.Drawing.Arrows -- | Drawing round cornered polygons. module Wumpus.Drawing.Paths.RoundCorners -- | The length of the control-point vector wants to be slighly longer than -- half of d (d - being the distance between the truncated -- points and the corner). cornerCurve :: (Real u, Floating u) => Point2 u -> Point2 u -> Point2 u -> Path u illustratePath :: Fractional u => Path u -> Graphic u -- | roundEvery throws a runtime error if the input list has less -- than 3 eleemnts. roundEvery :: (Real u, Floating u) => u -> [Point2 u] -> Path u -- | Common core for shapes -- -- ** WARNING ** - the types of Shapes are not ideal and are pending -- revision. module Wumpus.Drawing.Shapes.Base data Shape u t type LocShape u t = Point2 u -> Shape u t makeShape :: Num u => (ShapeCTM u -> Path u) -> (ShapeCTM u -> t u) -> LocShape u t type ShapeConstructor u t = ShapeCTM u -> t u borderedShape :: Num u => Shape u t -> Image u (t u) filledShape :: Num u => Shape u t -> Image u (t u) strokedShape :: Num u => Shape u t -> Image u (t u) data ShapeCTM u makeShapeCTM :: Num u => Point2 u -> ShapeCTM u data ShapeGeom u a runShapeGeom :: ShapeCTM u -> ShapeGeom u a -> a askCTM :: ShapeGeom u (ShapeCTM u) projectPoint :: (Real u, Floating u) => Point2 u -> ShapeGeom u (Point2 u) shapeCenter :: ShapeGeom u (Point2 u) shapeAngle :: ShapeGeom u Radian instance Eq u => Eq (ShapeCTM u) instance Ord u => Ord (ShapeCTM u) instance Show u => Show (ShapeCTM u) instance Monad (ShapeGeom u) instance Applicative (ShapeGeom u) instance Functor (ShapeGeom u) instance Num u => Translate (ShapeCTM u) instance (Real u, Floating u) => RotateAbout (ShapeCTM u) instance Rotate (ShapeCTM u) instance Num u => Scale (ShapeCTM u) instance Num u => Translate (Shape u sh) instance Num u => Scale (Shape u sh) instance (Real u, Floating u) => RotateAbout (Shape u sh) instance (Real u, Floating u) => Rotate (Shape u sh) -- | A Coordinate is operationally like a shape but it can only be drawn as -- a dot or a cross and it only supports CenterAnchor. -- -- Coordinates support affine transformations, however transfomations -- only displace a coordinate's origin they do not change how it is drawn -- (one cannot elongate the drawing of a coordinate with a scale). This -- is why coordinates are not Shapes, though one major use of coordinates -- is to illustrate anchor points on Shapes. module Wumpus.Drawing.Shapes.Coordinate -- | Coordinate data CoordinateAnchor u type DCoordinateAnchor = CoordinateAnchor Double data Coordinate u type DCoordinate = Coordinate Double coordinate :: Num u => LocCoordinate u coordinateDot :: (Real u, Floating u, FromPtSize u) => Coordinate u -> Image u (CoordinateAnchor u) -- | Note - the x is drawn regardless of any scaling or -- rotation. coordinateX :: (Real u, Floating u, FromPtSize u) => Coordinate u -> Image u (CoordinateAnchor u) instance Eq u => Eq (Coordinate u) instance Ord u => Ord (Coordinate u) instance Show u => Show (Coordinate u) instance Eq u => Eq (CoordinateAnchor u) instance Ord u => Ord (CoordinateAnchor u) instance Show u => Show (CoordinateAnchor u) instance Num u => Translate (Coordinate u) instance Num u => Scale (Coordinate u) instance (Real u, Floating u) => RotateAbout (Coordinate u) instance (Real u, Floating u) => Rotate (Coordinate u) instance (Real u, Floating u) => CenterAnchor (CoordinateAnchor u) -- | Simple shapes - rectangle, circle diamond, ellipse. module Wumpus.Drawing.Shapes.Derived data Rectangle u type DRectangle = Rectangle Double -- | rectangle : width * height -> shape rectangle :: (Real u, Floating u) => u -> u -> LocShape u Rectangle -- | rectangle : round_length * width * height -> shape -- rrectangle :: (Real u, Floating u) => u -> u -> u -> LocShape u Rectangle mkRectangle :: u -> u -> ShapeConstructor u Rectangle data Circle u type DCircle = Circle Double -- | circle : radius -> shape circle :: (Real u, Floating u) => u -> LocShape u Circle data Diamond u type DDiamond = Diamond Double -- | diamond : half_width * half_height -> shape -- -- Note - args might change to tull_width and full_height... diamond :: (Real u, Floating u) => u -> u -> LocShape u Diamond -- | rdiamond : round_length * half_width * half_height -> -- shape -- -- Note - args might change to full_width and full_height... rdiamond :: (Real u, Floating u) => u -> u -> u -> LocShape u Diamond data Ellipse u type DEllipse = Ellipse Double -- | ellipse : x_radii * y_radii -> shape ellipse :: (Real u, Floating u) => u -> u -> LocShape u Ellipse instance Eq u => Eq (Circle u) instance Show u => Show (Circle u) instance Eq u => Eq (Rectangle u) instance Ord u => Ord (Rectangle u) instance Show u => Show (Rectangle u) instance (Real u, Floating u) => CardinalAnchor2 (Ellipse u) instance (Real u, Floating u) => CardinalAnchor (Ellipse u) instance (Real u, Floating u) => RadialAnchor (Ellipse u) instance (Real u, Floating u) => CenterAnchor (Ellipse u) instance (Real u, Floating u) => RadialAnchor (Diamond u) instance (Real u, Floating u, Fractional u) => CardinalAnchor2 (Diamond u) instance (Real u, Floating u) => CardinalAnchor (Diamond u) instance (Real u, Floating u) => CenterAnchor (Diamond u) instance (Real u, Floating u) => RadialAnchor (Circle u) instance (Real u, Floating u) => CardinalAnchor2 (Circle u) instance (Real u, Floating u) => CardinalAnchor (Circle u) instance (Real u, Floating u) => CenterAnchor (Circle u) instance (Real u, Floating u) => RadialAnchor (Rectangle u) instance (Real u, Floating u) => CardinalAnchor2 (Rectangle u) instance (Real u, Floating u) => CardinalAnchor (Rectangle u) instance (Real u, Floating u) => CenterAnchor (Rectangle u) -- | Shim module for Shapes. module Wumpus.Drawing.Shapes -- | Turtle monad transformer. -- -- The Turtle monad embodies the LOGO style of imperative drawing - -- sending commands to update the a cursor. -- -- While Wumpus generally aims for a more compositional, -- "coordinate-free" style of drawing, some types of diagram are more -- easily expressed in the LOGO style. -- -- Turtle is only a transformer - it is intended to be run within a -- Drawing. module Wumpus.Drawing.Turtle.TurtleMonad data TurtleT u m a runTurtleT :: (Monad m, Num u) => (Int, Int) -> ScalingContext Int Int u -> TurtleT u m a -> m a instance (u ~ MonUnit m, Monad m, Num u) => PointSupplyM (TurtleT u m) instance (u ~ MonUnit m, Monad m, TraceM m) => TraceM (TurtleT u m) instance DrawingCtxM m => DrawingCtxM (TurtleT u m) instance Monad m => TurtleM (TurtleT u m) instance Monad m => Monad (TurtleT u m) instance Monad m => Applicative (TurtleT u m) instance Monad m => Functor (TurtleT u m)