combinat-0.2.8.1: Generate and manipulate various combinatorial objects.

Safe HaskellNone
LanguageHaskell2010

Math.Combinat.ASCII

Contents

Description

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).

Synopsis

The basic ASCII type

data ASCII Source

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.

Constructors

ASCII 

Fields

asciiSize :: (Int, Int)
 
asciiLines :: [String]
 

Instances

emptyRect :: ASCII Source

An empty (0x0) rectangle

Alignment

data HAlign Source

Horizontal alignment

Constructors

HLeft 
HCenter 
HRight 

data VAlign Source

Vertical alignment

Constructors

VTop 
VCenter 
VBottom 

data Alignment Source

Constructors

Align HAlign VAlign 

Separators

data HSep Source

Horizontal separator

Constructors

HSepEmpty

empty separator

HSepSpaces Int

n spaces

HSepString String

some custom string, eg. " | "

Instances

data VSep Source

Vertical separator

Constructors

VSepEmpty

empty separator

VSepSpaces Int

n spaces

VSepString [Char]

some custom list of characters, eg. " - " (the characters are interpreted as below each other)

Instances

Concatenation

(|||) :: ASCII -> ASCII -> ASCII Source

Horizontal append, centrally aligned, no separation.

(===) :: ASCII -> ASCII -> ASCII Source

Vertical append, centrally aligned, no separation.

hCatTop :: [ASCII] -> ASCII Source

Horizontal concatenation, top-aligned, no separation

hCatBot :: [ASCII] -> ASCII Source

Horizontal concatenation, bottom-aligned, no separation

vCatLeft :: [ASCII] -> ASCII Source

Vertical concatenation, left-aligned, no separation

vCatRight :: [ASCII] -> ASCII Source

Vertical concatenation, right-aligned, no separation

hCatWith :: VAlign -> HSep -> [ASCII] -> ASCII Source

General horizontal concatenation

vCatWith :: HAlign -> VSep -> [ASCII] -> ASCII Source

General vertical 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

pad :: ASCII -> ASCII Source

Pads by single empty lines vertically and two spaces horizontally

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.

hIndent :: Int -> ASCII -> ASCII Source

Horizontal indentation

vIndent :: Int -> ASCII -> ASCII Source

Vertical indentation

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] ]

pasteOnto' Source

Arguments

:: (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

Constructors

RowMajor 
ColMajor 

autoTabulate Source

Arguments

:: MatrixOrder

whether to use row-major or column-major ordering of the elements

-> Either Int Int

(Right x) creates x columns, while (Left y) creates y rows

-> [ASCII]

list of ASCII rectangles

-> ASCII 

Automatically tabulates ASCII rectangles.

Captions

caption :: String -> ASCII -> ASCII Source

Adds a caption to the bottom, with default settings.

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

asciiBox :: (Int, Int) -> ASCII Source

An ASCII border box of the given size

roundedAsciiBox :: (Int, Int) -> ASCII Source

An "rounded" ASCII border box of the given size

filledBox :: Char -> (Int, Int) -> ASCII Source

A box simply filled with the given character

transparentBox :: (Int, Int) -> ASCII Source

A box of spaces

Testing / miscellanea

asciiNumber :: Int -> ASCII Source

An integer

asciiShow :: Show a => a -> ASCII Source