Safe Haskell | None |
---|---|
Language | Haskell2010 |
A mini-DSL for ASCII drawing of structures.
From some structures there is also Graphviz and/or diagrams
(http://projects.haskell.org/diagrams) visualization support
(the latter in the separate libray combinat-diagrams
).
- data ASCII = ASCII {
- asciiSize :: (Int, Int)
- asciiLines :: [String]
- class DrawASCII a where
- emptyRect :: ASCII
- asciiXSize :: ASCII -> Int
- asciiYSize :: ASCII -> Int
- asciiString :: ASCII -> String
- printASCII :: ASCII -> IO ()
- asciiFromLines :: [String] -> ASCII
- asciiFromString :: String -> ASCII
- data HAlign
- data VAlign
- data Alignment = Align HAlign VAlign
- data HSep
- hSepSize :: HSep -> Int
- hSepString :: HSep -> String
- data VSep
- = VSepEmpty
- | VSepSpaces Int
- | VSepString [Char]
- vSepSize :: VSep -> Int
- vSepString :: VSep -> [Char]
- (|||) :: ASCII -> ASCII -> ASCII
- (===) :: ASCII -> ASCII -> ASCII
- hCatTop :: [ASCII] -> ASCII
- hCatBot :: [ASCII] -> ASCII
- vCatLeft :: [ASCII] -> ASCII
- vCatRight :: [ASCII] -> ASCII
- hCatWith :: VAlign -> HSep -> [ASCII] -> ASCII
- vCatWith :: HAlign -> VSep -> [ASCII] -> ASCII
- hPad :: Int -> ASCII -> ASCII
- vPad :: Int -> ASCII -> ASCII
- pad :: ASCII -> ASCII
- hExtendTo :: HAlign -> Int -> ASCII -> ASCII
- vExtendTo :: VAlign -> Int -> ASCII -> ASCII
- hExtendWith :: HAlign -> Int -> ASCII -> ASCII
- vExtendWith :: VAlign -> Int -> ASCII -> ASCII
- hIndent :: Int -> ASCII -> ASCII
- vIndent :: Int -> ASCII -> ASCII
- hCut :: HAlign -> Int -> ASCII -> ASCII
- vCut :: VAlign -> Int -> ASCII -> ASCII
- pasteOnto :: (Int, Int) -> ASCII -> ASCII -> ASCII
- pasteOnto' :: (Char -> Bool) -> (Int, Int) -> ASCII -> ASCII -> ASCII
- pasteOntoRel :: (HAlign, VAlign) -> (Int, Int) -> ASCII -> ASCII -> ASCII
- pasteOntoRel' :: (Char -> Bool) -> (HAlign, VAlign) -> (Int, Int) -> ASCII -> ASCII -> ASCII
- tabulate :: (HAlign, VAlign) -> (HSep, VSep) -> [[ASCII]] -> ASCII
- data MatrixOrder
- autoTabulate :: MatrixOrder -> Either Int Int -> [ASCII] -> ASCII
- caption :: String -> ASCII -> ASCII
- caption' :: Bool -> HAlign -> String -> ASCII -> ASCII
- asciiBox :: (Int, Int) -> ASCII
- roundedAsciiBox :: (Int, Int) -> ASCII
- filledBox :: Char -> (Int, Int) -> ASCII
- transparentBox :: (Int, Int) -> ASCII
- asciiNumber :: Int -> ASCII
- asciiShow :: Show a => a -> ASCII
The basic ASCII type
The type of a (rectangular) ASCII figure. Internally it is a list of lines of the same length plus the size.
Note: The Show instance is pretty-printing, so that it's convenient in ghci.
class DrawASCII a where Source
A type class to have a simple way to draw things
asciiXSize :: ASCII -> Int Source
asciiYSize :: ASCII -> Int Source
asciiString :: ASCII -> String Source
printASCII :: ASCII -> IO () Source
asciiFromLines :: [String] -> ASCII Source
asciiFromString :: String -> ASCII Source
Alignment
Separators
Horizontal separator
HSepEmpty | empty separator |
HSepSpaces Int |
|
HSepString String | some custom string, eg. |
hSepString :: HSep -> String Source
Vertical separator
VSepEmpty | empty separator |
VSepSpaces Int |
|
VSepString [Char] | some custom list of characters, eg. |
vSepString :: VSep -> [Char] Source
Concatenation
Padding
hPad :: Int -> ASCII -> ASCII Source
Horizontally pads with the given number of spaces, on both sides
vPad :: Int -> ASCII -> ASCII Source
Vertically pads with the given number of empty lines, on both sides
Extension
hExtendTo :: HAlign -> Int -> ASCII -> ASCII Source
Extends an ASCII figure with spaces horizontally to the given width. Note: the alignment is the alignment of the original picture in the new bigger picture!
vExtendTo :: VAlign -> Int -> ASCII -> ASCII Source
Extends an ASCII figure with spaces vertically to the given height. Note: the alignment is the alignment of the original picture in the new bigger picture!
hExtendWith :: HAlign -> Int -> ASCII -> ASCII Source
Extend horizontally with the given number of spaces.
vExtendWith :: VAlign -> Int -> ASCII -> ASCII Source
Extend vertically with the given number of empty lines.
Cutting
hCut :: HAlign -> Int -> ASCII -> ASCII Source
Cuts the given number of columns from the picture. The alignment is the alignment of the picture, not the cuts.
This should be the (left) inverse of hExtendWith
.
vCut :: VAlign -> Int -> ASCII -> ASCII Source
Cuts the given number of rows from the picture. The alignment is the alignment of the picture, not the cuts.
This should be the (left) inverse of vExtendWith
.
Pasting
pasteOnto :: (Int, Int) -> ASCII -> ASCII -> ASCII Source
Pastes the first ASCII graphics onto the second, keeping the second one's dimension (that is, overlapping parts of the first one are ignored). The offset is relative to the top-left corner of the second picture. Spaces at treated as transparent.
Example:
tabulate (HCenter,VCenter) (HSepSpaces 2, VSepSpaces 1) [ [ caption (show (x,y)) $ pasteOnto (x,y) (filledBox '@' (4,3)) (asciiBox (7,5)) | x <- [-4..7] ] | y <- [-3..5] ]
:: (Char -> Bool) | transparency condition |
-> (Int, Int) | offset relative to the top-left corner of the second picture |
-> ASCII | picture to paste |
-> ASCII | picture to paste onto |
-> ASCII |
Pastes the first ASCII graphics onto the second, keeping the second one's dimension. The first argument specifies the transparency condition (on the first picture). The offset is relative to the top-left corner of the second picture.
pasteOntoRel :: (HAlign, VAlign) -> (Int, Int) -> ASCII -> ASCII -> ASCII Source
A version of pasteOnto
where we can specify the corner of the second picture
to which the offset is relative:
pasteOntoRel (HLeft,VTop) == pasteOnto
Tabulate
tabulate :: (HAlign, VAlign) -> (HSep, VSep) -> [[ASCII]] -> ASCII Source
Tabulates the given matrix of pictures. Example:
tabulate (HCenter, VCenter) (HSepSpaces 2, VSepSpaces 1) [ [ asciiFromLines [ "x=" ++ show x , "y=" ++ show y ] | x<-[7..13] ] | y<-[98..102] ]
data MatrixOrder Source
Order of elements in a matrix
:: MatrixOrder | whether to use row-major or column-major ordering of the elements |
-> Either Int Int |
|
-> [ASCII] | list of ASCII rectangles |
-> ASCII |
Automatically tabulates ASCII rectangles.
Captions
caption' :: Bool -> HAlign -> String -> ASCII -> ASCII Source
Adds a caption to the bottom. The Bool
flag specifies whether to add an empty between
the caption and the figure
Ready-made boxes
roundedAsciiBox :: (Int, Int) -> ASCII Source
An "rounded" ASCII border box of the given size
transparentBox :: (Int, Int) -> ASCII Source
A box of spaces
Testing / miscellanea
asciiNumber :: Int -> ASCII Source
An integer