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

module Math.Combinat.ASCII where

--------------------------------------------------------------------------------

import Data.Char ( isSpace )
import Data.List ( transpose , intercalate )

import Math.Combinat.Helper

--------------------------------------------------------------------------------
-- * 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.
--
data ASCII = ASCII 
  { ASCII -> (Int, Int)
asciiSize  :: (Int,Int) 
  , ASCII -> [String]
asciiLines :: [String]
  }

-- | A type class to have a simple way to draw things 
class DrawASCII a where
  ascii :: a -> ASCII

instance Show ASCII where
  show :: ASCII -> String
show = ASCII -> String
asciiString

-- | An empty (0x0) rectangle
emptyRect :: ASCII
emptyRect :: ASCII
emptyRect = (Int, Int) -> [String] -> ASCII
ASCII (Int
0,Int
0) []

asciiXSize, asciiYSize :: ASCII -> Int
asciiXSize :: ASCII -> Int
asciiXSize = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII -> (Int, Int)
asciiSize
asciiYSize :: ASCII -> Int
asciiYSize = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII -> (Int, Int)
asciiSize

asciiString :: ASCII -> String
asciiString :: ASCII -> String
asciiString (ASCII (Int, Int)
sz [String]
ls) = [String] -> String
unlines [String]
ls

printASCII :: ASCII -> IO ()
printASCII :: ASCII -> IO ()
printASCII = String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII -> String
asciiString

asciiFromLines :: [String] -> ASCII
asciiFromLines :: [String] -> ASCII
asciiFromLines [String]
ls = (Int, Int) -> [String] -> ASCII
ASCII (Int
x,Int
y) (forall a b. (a -> b) -> [a] -> [b]
map ShowS
f [String]
ls) where
  y :: Int
y   = forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls
  x :: Int
x   = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls)
  f :: ShowS
f String
l = String
l forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
x forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
l) Char
' '

asciiFromString :: String -> ASCII
asciiFromString :: String -> ASCII
asciiFromString = [String] -> ASCII
asciiFromLines forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

--------------------------------------------------------------------------------
-- * Alignment

-- | Horizontal alignment
data HAlign 
  = HLeft 
  | HCenter 
  | HRight 
  deriving (HAlign -> HAlign -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HAlign -> HAlign -> Bool
$c/= :: HAlign -> HAlign -> Bool
== :: HAlign -> HAlign -> Bool
$c== :: HAlign -> HAlign -> Bool
Eq,Int -> HAlign -> ShowS
[HAlign] -> ShowS
HAlign -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HAlign] -> ShowS
$cshowList :: [HAlign] -> ShowS
show :: HAlign -> String
$cshow :: HAlign -> String
showsPrec :: Int -> HAlign -> ShowS
$cshowsPrec :: Int -> HAlign -> ShowS
Show)

-- | Vertical alignment
data VAlign 
  = VTop 
  | VCenter 
  | VBottom 
  deriving (VAlign -> VAlign -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VAlign -> VAlign -> Bool
$c/= :: VAlign -> VAlign -> Bool
== :: VAlign -> VAlign -> Bool
$c== :: VAlign -> VAlign -> Bool
Eq,Int -> VAlign -> ShowS
[VAlign] -> ShowS
VAlign -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VAlign] -> ShowS
$cshowList :: [VAlign] -> ShowS
show :: VAlign -> String
$cshow :: VAlign -> String
showsPrec :: Int -> VAlign -> ShowS
$cshowsPrec :: Int -> VAlign -> ShowS
Show)

data Alignment = Align HAlign VAlign

--------------------------------------------------------------------------------
-- * Separators

-- | Horizontal separator
data HSep 
  = HSepEmpty           -- ^ empty separator
  | HSepSpaces Int      -- ^ @n@ spaces
  | HSepString String   -- ^ some custom string, eg. @\" | \"@
  deriving Int -> HSep -> ShowS
[HSep] -> ShowS
HSep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HSep] -> ShowS
$cshowList :: [HSep] -> ShowS
show :: HSep -> String
$cshow :: HSep -> String
showsPrec :: Int -> HSep -> ShowS
$cshowsPrec :: Int -> HSep -> ShowS
Show

hSepSize :: HSep -> Int
hSepSize :: HSep -> Int
hSepSize HSep
hsep = case HSep
hsep of
  HSep
HSepEmpty    -> Int
0
  HSepSpaces Int
k -> Int
k
  HSepString String
s -> forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s

hSepString :: HSep -> String
hSepString :: HSep -> String
hSepString HSep
hsep = case HSep
hsep of
  HSep
HSepEmpty    -> String
""
  HSepSpaces Int
k -> forall a. Int -> a -> [a]
replicate Int
k Char
' '
  HSepString String
s -> String
s

-- | Vertical separator
data VSep 
  = VSepEmpty           -- ^ empty separator
  | VSepSpaces Int      -- ^ @n@ spaces
  | VSepString [Char]   -- ^ some custom list of characters, eg. @\" - \"@ (the characters are interpreted as below each other)
  deriving Int -> VSep -> ShowS
[VSep] -> ShowS
VSep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VSep] -> ShowS
$cshowList :: [VSep] -> ShowS
show :: VSep -> String
$cshow :: VSep -> String
showsPrec :: Int -> VSep -> ShowS
$cshowsPrec :: Int -> VSep -> ShowS
Show

vSepSize :: VSep -> Int
vSepSize :: VSep -> Int
vSepSize VSep
vsep = case VSep
vsep of
  VSep
VSepEmpty    -> Int
0
  VSepSpaces Int
k -> Int
k
  VSepString String
s -> forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s

vSepString :: VSep -> [Char]
vSepString :: VSep -> String
vSepString VSep
vsep = case VSep
vsep of
  VSep
VSepEmpty    -> []
  VSepSpaces Int
k -> forall a. Int -> a -> [a]
replicate Int
k Char
' '
  VSepString String
s -> String
s
                                        
--------------------------------------------------------------------------------
-- * Concatenation

-- | Horizontal append, centrally aligned, no separation.
(|||) :: ASCII -> ASCII -> ASCII
||| :: ASCII -> ASCII -> ASCII
(|||) ASCII
p ASCII
q = VAlign -> HSep -> [ASCII] -> ASCII
hCatWith VAlign
VCenter HSep
HSepEmpty [ASCII
p,ASCII
q]

-- | Vertical append, centrally aligned, no separation.
(===) :: ASCII -> ASCII -> ASCII
=== :: ASCII -> ASCII -> ASCII
(===) ASCII
p ASCII
q = HAlign -> VSep -> [ASCII] -> ASCII
vCatWith HAlign
HCenter VSep
VSepEmpty [ASCII
p,ASCII
q]

-- | Horizontal concatenation, top-aligned, no separation
hCatTop :: [ASCII] -> ASCII
hCatTop :: [ASCII] -> ASCII
hCatTop = VAlign -> HSep -> [ASCII] -> ASCII
hCatWith VAlign
VTop HSep
HSepEmpty

-- | Horizontal concatenation, bottom-aligned, no separation
hCatBot :: [ASCII] -> ASCII
hCatBot :: [ASCII] -> ASCII
hCatBot = VAlign -> HSep -> [ASCII] -> ASCII
hCatWith VAlign
VBottom HSep
HSepEmpty

-- | Vertical concatenation, left-aligned, no separation
vCatLeft :: [ASCII] -> ASCII
vCatLeft :: [ASCII] -> ASCII
vCatLeft = HAlign -> VSep -> [ASCII] -> ASCII
vCatWith HAlign
HLeft VSep
VSepEmpty

-- | Vertical concatenation, right-aligned, no separation
vCatRight :: [ASCII] -> ASCII
vCatRight :: [ASCII] -> ASCII
vCatRight = HAlign -> VSep -> [ASCII] -> ASCII
vCatWith HAlign
HRight VSep
VSepEmpty

-- | General horizontal concatenation
hCatWith :: VAlign -> HSep -> [ASCII] -> ASCII
hCatWith :: VAlign -> HSep -> [ASCII] -> ASCII
hCatWith VAlign
valign HSep
hsep [ASCII]
rects = (Int, Int) -> [String] -> ASCII
ASCII (Int
x',Int
maxy) [String]
final where
  n :: Int
n    = forall (t :: * -> *) a. Foldable t => t a -> Int
length [ASCII]
rects
  maxy :: Int
maxy = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ Int
y | ASCII (Int
_,Int
y) [String]
_ <- [ASCII]
rects ]
  xsz :: [Int]
xsz  =         [ Int
x | ASCII (Int
x,Int
_) [String]
_ <- [ASCII]
rects ]
  sep :: String
sep   = HSep -> String
hSepString HSep
hsep
  sepx :: Int
sepx  = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sep
  rects1 :: [ASCII]
rects1 = forall a b. (a -> b) -> [a] -> [b]
map (VAlign -> Int -> ASCII -> ASCII
vExtendTo VAlign
valign Int
maxy) [ASCII]
rects
  x' :: Int
x' = forall a. Num a => [a] -> a
sum' [Int]
xsz forall a. Num a => a -> a -> a
+ (Int
nforall a. Num a => a -> a -> a
-Int
1)forall a. Num a => a -> a -> a
*Int
sepx
  final :: [String]
final = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [[a]] -> [a]
intercalate String
sep) forall a b. (a -> b) -> a -> b
$ forall a. [[a]] -> [[a]]
transpose (forall a b. (a -> b) -> [a] -> [b]
map ASCII -> [String]
asciiLines [ASCII]
rects1)

-- | General vertical concatenation
vCatWith :: HAlign -> VSep -> [ASCII] -> ASCII
vCatWith :: HAlign -> VSep -> [ASCII] -> ASCII
vCatWith HAlign
halign VSep
vsep [ASCII]
rects = (Int, Int) -> [String] -> ASCII
ASCII (Int
maxx,Int
y') [String]
final where
  n :: Int
n    = forall (t :: * -> *) a. Foldable t => t a -> Int
length [ASCII]
rects
  maxx :: Int
maxx = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ Int
x | ASCII (Int
x,Int
_) [String]
_ <- [ASCII]
rects ]
  ysz :: [Int]
ysz  =         [ Int
y | ASCII (Int
_,Int
y) [String]
_ <- [ASCII]
rects ]
  sepy :: Int
sepy    = VSep -> Int
vSepSize VSep
vsep
  fullsep :: [String]
fullsep = forall a. [[a]] -> [[a]]
transpose (forall a. Int -> a -> [a]
replicate Int
maxx forall a b. (a -> b) -> a -> b
$ VSep -> String
vSepString VSep
vsep) :: [String]
  rects1 :: [ASCII]
rects1  = forall a b. (a -> b) -> [a] -> [b]
map (HAlign -> Int -> ASCII -> ASCII
hExtendTo HAlign
halign Int
maxx) [ASCII]
rects
  y' :: Int
y'    = forall a. Num a => [a] -> a
sum' [Int]
ysz forall a. Num a => a -> a -> a
+ (Int
nforall a. Num a => a -> a -> a
-Int
1)forall a. Num a => a -> a -> a
*Int
sepy
  final :: [String]
final = forall a. [a] -> [[a]] -> [a]
intercalate [String]
fullsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ASCII -> [String]
asciiLines [ASCII]
rects1

--------------------------------------------------------------------------------
-- * Padding

-- | Horizontally pads with the given number of spaces, on both sides
hPad :: Int -> ASCII -> ASCII
hPad :: Int -> ASCII -> ASCII
hPad Int
k (ASCII (Int
x,Int
y) [String]
ls) = (Int, Int) -> [String] -> ASCII
ASCII (Int
xforall a. Num a => a -> a -> a
+Int
2forall a. Num a => a -> a -> a
*Int
k,Int
y) (forall a b. (a -> b) -> [a] -> [b]
map ShowS
f [String]
ls) where
  f :: ShowS
f String
l = String
pad forall a. [a] -> [a] -> [a]
++ String
l forall a. [a] -> [a] -> [a]
++ String
pad 
  pad :: String
pad = forall a. Int -> a -> [a]
replicate Int
k Char
' '

-- | Vertically pads with the given number of empty lines, on both sides
vPad :: Int -> ASCII -> ASCII
vPad :: Int -> ASCII -> ASCII
vPad Int
k (ASCII (Int
x,Int
y) [String]
ls) = (Int, Int) -> [String] -> ASCII
ASCII (Int
x,Int
yforall a. Num a => a -> a -> a
+Int
2forall a. Num a => a -> a -> a
*Int
k) ([String]
pad forall a. [a] -> [a] -> [a]
++ [String]
ls forall a. [a] -> [a] -> [a]
++ [String]
pad) where
  pad :: [String]
pad = forall a. Int -> a -> [a]
replicate Int
k (forall a. Int -> a -> [a]
replicate Int
x Char
' ')

-- | Pads by single empty lines vertically and two spaces horizontally
pad :: ASCII -> ASCII
pad :: ASCII -> ASCII
pad = Int -> ASCII -> ASCII
vPad Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ASCII -> ASCII
hPad Int
2 

--------------------------------------------------------------------------------
-- * Extension

-- | 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!
hExtendTo :: HAlign -> Int -> ASCII -> ASCII
hExtendTo :: HAlign -> Int -> ASCII -> ASCII
hExtendTo HAlign
halign Int
n0 rect :: ASCII
rect@(ASCII (Int
x,Int
y) [String]
ls) = HAlign -> Int -> ASCII -> ASCII
hExtendWith HAlign
halign (forall a. Ord a => a -> a -> a
max Int
n0 Int
x forall a. Num a => a -> a -> a
- Int
x) ASCII
rect
  
-- | 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!
vExtendTo :: VAlign -> Int -> ASCII -> ASCII
vExtendTo :: VAlign -> Int -> ASCII -> ASCII
vExtendTo VAlign
valign Int
n0 rect :: ASCII
rect@(ASCII (Int
x,Int
y) [String]
ls) = VAlign -> Int -> ASCII -> ASCII
vExtendWith VAlign
valign (forall a. Ord a => a -> a -> a
max Int
n0 Int
y forall a. Num a => a -> a -> a
- Int
y) ASCII
rect

-- | Extend horizontally with the given number of spaces.
hExtendWith :: HAlign -> Int -> ASCII -> ASCII
hExtendWith :: HAlign -> Int -> ASCII -> ASCII
hExtendWith HAlign
alignment Int
d (ASCII (Int
x,Int
y) [String]
ls) = (Int, Int) -> [String] -> ASCII
ASCII (Int
xforall a. Num a => a -> a -> a
+Int
d,Int
y) (forall a b. (a -> b) -> [a] -> [b]
map ShowS
f [String]
ls) where
  f :: ShowS
f String
l = case HAlign
alignment of
    HAlign
HLeft   -> String
l forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
d Char
' '   
    HAlign
HRight  -> forall a. Int -> a -> [a]
replicate Int
d Char
' ' forall a. [a] -> [a] -> [a]
++ String
l
    HAlign
HCenter -> forall a. Int -> a -> [a]
replicate Int
a Char
' ' forall a. [a] -> [a] -> [a]
++ String
l forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
dforall a. Num a => a -> a -> a
-Int
a) Char
' ' 
  a :: Int
a = forall a. Integral a => a -> a -> a
div Int
d Int
2

-- | Extend vertically with the given number of empty lines.
vExtendWith :: VAlign -> Int -> ASCII -> ASCII
vExtendWith :: VAlign -> Int -> ASCII -> ASCII
vExtendWith VAlign
valign Int
d (ASCII (Int
x,Int
y) [String]
ls) = (Int, Int) -> [String] -> ASCII
ASCII (Int
x,Int
yforall a. Num a => a -> a -> a
+Int
d) ([String] -> [String]
f [String]
ls) where
  f :: [String] -> [String]
f [String]
ls = case VAlign
valign of
    VAlign
VTop     -> [String]
ls forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
d String
emptyline   
    VAlign
VBottom  -> forall a. Int -> a -> [a]
replicate Int
d String
emptyline forall a. [a] -> [a] -> [a]
++ [String]
ls
    VAlign
VCenter  -> forall a. Int -> a -> [a]
replicate Int
a String
emptyline forall a. [a] -> [a] -> [a]
++ [String]
ls forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
dforall a. Num a => a -> a -> a
-Int
a) String
emptyline
  a :: Int
a = forall a. Integral a => a -> a -> a
div Int
d Int
2
  emptyline :: String
emptyline = forall a. Int -> a -> [a]
replicate Int
x Char
' '

-- | Horizontal indentation
hIndent :: Int -> ASCII -> ASCII
hIndent :: Int -> ASCII -> ASCII
hIndent Int
d = HAlign -> Int -> ASCII -> ASCII
hExtendWith HAlign
HRight Int
d

-- | Vertical indentation
vIndent :: Int -> ASCII -> ASCII
vIndent :: Int -> ASCII -> ASCII
vIndent Int
d = VAlign -> Int -> ASCII -> ASCII
vExtendWith VAlign
VBottom Int
d

--------------------------------------------------------------------------------
-- * Cutting

-- | 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'.
hCut :: HAlign -> Int -> ASCII -> ASCII
hCut :: HAlign -> Int -> ASCII -> ASCII
hCut HAlign
halign Int
k (ASCII (Int
x,Int
y) [String]
ls) = (Int, Int) -> [String] -> ASCII
ASCII (Int
x',Int
y) (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. [a] -> [a]
f [String]
ls) where
  x' :: Int
x' = forall a. Ord a => a -> a -> a
max Int
0 (Int
xforall a. Num a => a -> a -> a
-Int
k)
  f :: [a] -> [a]
f  = case HAlign
halign of
    HAlign
HLeft   -> forall {a}. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop  Int
k    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. [a] -> [a]
reverse
    HAlign
HCenter -> forall {a}. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop (Int
kforall a. Num a => a -> a -> a
-Int
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
a
    HAlign
HRight  -> forall a. Int -> [a] -> [a]
drop Int
k 
  a :: Int
a = forall a. Integral a => a -> a -> a
div Int
k Int
2

-- | 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'.
vCut :: VAlign -> Int -> ASCII -> ASCII
vCut :: VAlign -> Int -> ASCII -> ASCII
vCut VAlign
valign Int
k (ASCII (Int
x,Int
y) [String]
ls) = (Int, Int) -> [String] -> ASCII
ASCII (Int
x,Int
y') (forall {a}. [a] -> [a]
g [String]
ls) where
  y' :: Int
y' = forall a. Ord a => a -> a -> a
max Int
0 (Int
yforall a. Num a => a -> a -> a
-Int
k)
  g :: [a] -> [a]
g  = case VAlign
valign of
    VAlign
VTop    -> forall {a}. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop  Int
k    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. [a] -> [a]
reverse
    VAlign
VCenter -> forall {a}. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop (Int
kforall a. Num a => a -> a -> a
-Int
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
a
    VAlign
VBottom -> forall a. Int -> [a] -> [a]
drop Int
k 
  a :: Int
a = forall a. Integral a => a -> a -> a
div Int
k Int
2

--------------------------------------------------------------------------------
-- * Pasting

-- | 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 :: (Int,Int) -> ASCII -> ASCII -> ASCII
pasteOnto :: (Int, Int) -> ASCII -> ASCII -> ASCII
pasteOnto = (Char -> Bool) -> (Int, Int) -> ASCII -> ASCII -> ASCII
pasteOnto' Char -> Bool
isSpace 

-- | 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.
-- 
pasteOnto' 
  :: (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
pasteOnto' :: (Char -> Bool) -> (Int, Int) -> ASCII -> ASCII -> ASCII
pasteOnto' Char -> Bool
transparent (Int
xpos,Int
ypos) ASCII
small ASCII
big = ASCII
new where
  new :: ASCII
new = (Int, Int) -> [String] -> ASCII
ASCII (Int
xbig,Int
ybig) [String]
lines'
  (Int
xbig,Int
ybig) = ASCII -> (Int, Int)
asciiSize  ASCII
big
  bigLines :: [String]
bigLines    = ASCII -> [String]
asciiLines ASCII
big
  small' :: ASCII
small'      = (if (Int
yposforall a. Ord a => a -> a -> Bool
>=Int
0) then VAlign -> Int -> ASCII -> ASCII
vExtendWith VAlign
VBottom Int
ypos else VAlign -> Int -> ASCII -> ASCII
vCut VAlign
VBottom (-Int
ypos))
              forall a b. (a -> b) -> a -> b
$ (if (Int
xposforall a. Ord a => a -> a -> Bool
>=Int
0) then HAlign -> Int -> ASCII -> ASCII
hExtendWith HAlign
HRight  Int
xpos else HAlign -> Int -> ASCII -> ASCII
hCut HAlign
HRight  (-Int
xpos))
              forall a b. (a -> b) -> a -> b
$ ASCII
small
  smallLines :: [String]
smallLines  = ASCII -> [String]
asciiLines ASCII
small'
  lines' :: [String]
lines'  = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> ShowS
f [String]
bigLines ([String]
smallLines forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat String
"")
  f :: String -> ShowS
f String
bl String
sl = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Char -> Char -> Char
g String
bl (String
sl forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Char
' ')
  g :: Char -> Char -> Char
g Char
b  Char
s  = if Char -> Bool
transparent Char
s then Char
b else Char
s

-- | A version of 'pasteOnto' where we can specify the corner of the second picture
-- to which the offset is relative:
--
-- > pasteOntoRel (HLeft,VTop) == pasteOnto
--
pasteOntoRel :: (HAlign,VAlign) -> (Int,Int) -> ASCII -> ASCII -> ASCII
pasteOntoRel :: (HAlign, VAlign) -> (Int, Int) -> ASCII -> ASCII -> ASCII
pasteOntoRel = (Char -> Bool)
-> (HAlign, VAlign) -> (Int, Int) -> ASCII -> ASCII -> ASCII
pasteOntoRel' Char -> Bool
isSpace

pasteOntoRel' :: (Char -> Bool) -> (HAlign,VAlign) -> (Int,Int) -> ASCII -> ASCII -> ASCII
pasteOntoRel' :: (Char -> Bool)
-> (HAlign, VAlign) -> (Int, Int) -> ASCII -> ASCII -> ASCII
pasteOntoRel' Char -> Bool
transparent (HAlign
halign,VAlign
valign) (Int
xpos,Int
ypos) ASCII
small ASCII
big = ASCII
new where
  new :: ASCII
new = (Char -> Bool) -> (Int, Int) -> ASCII -> ASCII -> ASCII
pasteOnto' Char -> Bool
transparent (Int
xpos',Int
ypos') ASCII
small ASCII
big 
  (Int
xsize,Int
ysize) = ASCII -> (Int, Int)
asciiSize ASCII
big
  xpos' :: Int
xpos' = case HAlign
halign of
    HAlign
HLeft   -> Int
xpos
    HAlign
HCenter -> Int
xpos forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> a -> a
div Int
xsize Int
2
    HAlign
HRight  -> Int
xpos forall a. Num a => a -> a -> a
+     Int
xsize
  ypos' :: Int
ypos' = case VAlign
valign of
    VAlign
VTop    -> Int
ypos
    VAlign
VCenter -> Int
ypos forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> a -> a
div Int
ysize Int
2
    VAlign
VBottom -> Int
ypos forall a. Num a => a -> a -> a
+     Int
ysize

--------------------------------------------------------------------------------
-- * Tabulate

-- | 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] ]
--
tabulate :: (HAlign,VAlign) -> (HSep,VSep) -> [[ASCII]] -> ASCII
tabulate :: (HAlign, VAlign) -> (HSep, VSep) -> [[ASCII]] -> ASCII
tabulate (HAlign
halign,VAlign
valign) (HSep
hsep,VSep
vsep) [[ASCII]]
rects0 = ASCII
final where
  n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[ASCII]]
rects0
  m :: Int
m = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [[ASCII]]
rects0)
  rects1 :: [[ASCII]]
rects1 = forall a b. (a -> b) -> [a] -> [b]
map (\[ASCII]
rs -> [ASCII]
rs forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
m forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [ASCII]
rs) ASCII
emptyRect) [[ASCII]]
rects0
  ys :: [Int]
ys = forall a b. (a -> b) -> [a] -> [b]
map (\[ASCII]
rs -> forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map ASCII -> Int
asciiYSize [ASCII]
rs)) [[ASCII]]
rects1
  xs :: [Int]
xs = forall a b. (a -> b) -> [a] -> [b]
map (\[ASCII]
rs -> forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map ASCII -> Int
asciiXSize [ASCII]
rs)) (forall a. [[a]] -> [[a]]
transpose [[ASCII]]
rects1)
  rects2 :: [[ASCII]]
rects2 = forall a b. (a -> b) -> [a] -> [b]
map (\[ASCII]
rs -> [      HAlign -> Int -> ASCII -> ASCII
hExtendTo HAlign
halign Int
x  ASCII
r  | (Int
x,ASCII
r ) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
xs [ASCII]
rs     ]) [[ASCII]]
rects1
  rects3 :: [[ASCII]]
rects3 =             [ forall a b. (a -> b) -> [a] -> [b]
map (VAlign -> Int -> ASCII -> ASCII
vExtendTo VAlign
valign Int
y) [ASCII]
rs | (Int
y,[ASCII]
rs) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ys [[ASCII]]
rects2 ]  
  final :: ASCII
final  = HAlign -> VSep -> [ASCII] -> ASCII
vCatWith HAlign
HLeft VSep
vsep 
         forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (VAlign -> HSep -> [ASCII] -> ASCII
hCatWith VAlign
VTop HSep
hsep) [[ASCII]]
rects3

-- | Order of elements in a matrix
data MatrixOrder 
  = RowMajor
  | ColMajor
  deriving (MatrixOrder -> MatrixOrder -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatrixOrder -> MatrixOrder -> Bool
$c/= :: MatrixOrder -> MatrixOrder -> Bool
== :: MatrixOrder -> MatrixOrder -> Bool
$c== :: MatrixOrder -> MatrixOrder -> Bool
Eq,Eq MatrixOrder
MatrixOrder -> MatrixOrder -> Bool
MatrixOrder -> MatrixOrder -> Ordering
MatrixOrder -> MatrixOrder -> MatrixOrder
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MatrixOrder -> MatrixOrder -> MatrixOrder
$cmin :: MatrixOrder -> MatrixOrder -> MatrixOrder
max :: MatrixOrder -> MatrixOrder -> MatrixOrder
$cmax :: MatrixOrder -> MatrixOrder -> MatrixOrder
>= :: MatrixOrder -> MatrixOrder -> Bool
$c>= :: MatrixOrder -> MatrixOrder -> Bool
> :: MatrixOrder -> MatrixOrder -> Bool
$c> :: MatrixOrder -> MatrixOrder -> Bool
<= :: MatrixOrder -> MatrixOrder -> Bool
$c<= :: MatrixOrder -> MatrixOrder -> Bool
< :: MatrixOrder -> MatrixOrder -> Bool
$c< :: MatrixOrder -> MatrixOrder -> Bool
compare :: MatrixOrder -> MatrixOrder -> Ordering
$ccompare :: MatrixOrder -> MatrixOrder -> Ordering
Ord,Int -> MatrixOrder -> ShowS
[MatrixOrder] -> ShowS
MatrixOrder -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatrixOrder] -> ShowS
$cshowList :: [MatrixOrder] -> ShowS
show :: MatrixOrder -> String
$cshow :: MatrixOrder -> String
showsPrec :: Int -> MatrixOrder -> ShowS
$cshowsPrec :: Int -> MatrixOrder -> ShowS
Show,ReadPrec [MatrixOrder]
ReadPrec MatrixOrder
Int -> ReadS MatrixOrder
ReadS [MatrixOrder]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MatrixOrder]
$creadListPrec :: ReadPrec [MatrixOrder]
readPrec :: ReadPrec MatrixOrder
$creadPrec :: ReadPrec MatrixOrder
readList :: ReadS [MatrixOrder]
$creadList :: ReadS [MatrixOrder]
readsPrec :: Int -> ReadS MatrixOrder
$creadsPrec :: Int -> ReadS MatrixOrder
Read)

-- | Automatically tabulates ASCII rectangles.
--
autoTabulate 
  :: 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
autoTabulate :: MatrixOrder -> Either Int Int -> [ASCII] -> ASCII
autoTabulate MatrixOrder
mtxorder Either Int Int
ei [ASCII]
list = ASCII
final where
  
  final :: ASCII
final = (HAlign, VAlign) -> (HSep, VSep) -> [[ASCII]] -> ASCII
tabulate (HAlign
HLeft,VAlign
VBottom) (Int -> HSep
HSepSpaces Int
2,Int -> VSep
VSepSpaces Int
1) [[ASCII]]
rects 

  n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [ASCII]
list

  rects :: [[ASCII]]
rects = case Either Int Int
ei of

    Left Int
y  -> case MatrixOrder
mtxorder of
                 MatrixOrder
ColMajor -> forall a. [[a]] -> [[a]]
transpose (forall {a}. Int -> [a] -> [[a]]
parts Int
y [ASCII]
list)
                 MatrixOrder
RowMajor -> forall {a}. Int -> [a] -> [[a]]
invparts Int
y [ASCII]
list

    Right Int
x -> case MatrixOrder
mtxorder of
                 MatrixOrder
ColMajor -> forall a. [[a]] -> [[a]]
transpose (forall {a}. Int -> [a] -> [[a]]
invparts Int
x [ASCII]
list)
                 MatrixOrder
RowMajor -> forall {a}. Int -> [a] -> [[a]]
parts Int
x [ASCII]
list

  transposeIf :: Bool -> [[a]] -> [[a]]
transposeIf Bool
b = if Bool
b then forall a. [[a]] -> [[a]]
transpose else forall a. a -> a
id

  -- chops into parts (the last one can be smaller)
  parts :: Int -> [a] -> [[a]]
parts Int
d = forall {a}. [a] -> [[a]]
go where
    go :: [a] -> [[a]]
go [] = []
    go [a]
xs = forall a. Int -> [a] -> [a]
take Int
d [a]
xs forall a. a -> [a] -> [a]
: [a] -> [[a]]
go (forall a. Int -> [a] -> [a]
drop Int
d [a]
xs)

  invparts :: Int -> [a] -> [[a]]
invparts Int
d [a]
xs = forall {a}. [Int] -> [a] -> [[a]]
parts' [Int]
ds [a]
xs where
    (Int
q,Int
r) = forall a. Integral a => a -> a -> (a, a)
divMod Int
n Int
d
    ds :: [Int]
ds = forall a. Int -> a -> [a]
replicate Int
r (Int
qforall a. Num a => a -> a -> a
+Int
1) forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
dforall a. Num a => a -> a -> a
-Int
r) Int
q

  parts' :: [Int] -> [a] -> [[a]]
parts' [Int]
ds [a]
xs = forall {a}. [Int] -> [a] -> [[a]]
go [Int]
ds [a]
xs where
    go :: [Int] -> [a] -> [[a]]
go [Int]
_  [] = []                                      
    go [] [a]
_  = []
    go (Int
d:[Int]
ds) [a]
xs = forall a. Int -> [a] -> [a]
take Int
d [a]
xs forall a. a -> [a] -> [a]
: [Int] -> [a] -> [[a]]
go [Int]
ds (forall a. Int -> [a] -> [a]
drop Int
d [a]
xs)

--------------------------------------------------------------------------------
-- * Captions

-- | Adds a caption to the bottom, with default settings.
caption :: String -> ASCII -> ASCII
caption :: String -> ASCII -> ASCII
caption = Bool -> HAlign -> String -> ASCII -> ASCII
caption' Bool
False HAlign
HLeft

-- | Adds a caption to the bottom. The @Bool@ flag specifies whether to add an empty between 
-- the caption and the figure
caption' :: Bool -> HAlign -> String -> ASCII -> ASCII
caption' :: Bool -> HAlign -> String -> ASCII -> ASCII
caption' Bool
emptyline HAlign
halign String
str ASCII
rect = HAlign -> VSep -> [ASCII] -> ASCII
vCatWith HAlign
halign VSep
sep [ASCII
rect,ASCII
capt] where
  sep :: VSep
sep  = if Bool
emptyline then Int -> VSep
VSepSpaces Int
1 else VSep
VSepEmpty 
  capt :: ASCII
capt = String -> ASCII
asciiFromString String
str

--------------------------------------------------------------------------------
-- * Ready-made boxes

-- | An ASCII border box of the given size 
asciiBox :: (Int,Int) -> ASCII
asciiBox :: (Int, Int) -> ASCII
asciiBox (Int
x,Int
y) = (Int, Int) -> [String] -> ASCII
ASCII (forall a. Ord a => a -> a -> a
max Int
x Int
2, forall a. Ord a => a -> a -> a
max Int
y Int
2) (String
h forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate (Int
yforall a. Num a => a -> a -> a
-Int
2) String
m forall a. [a] -> [a] -> [a]
++ [String
h]) where
  h :: String
h = String
"+" forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
xforall a. Num a => a -> a -> a
-Int
2) Char
'-' forall a. [a] -> [a] -> [a]
++ String
"+"
  m :: String
m = String
"|" forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
xforall a. Num a => a -> a -> a
-Int
2) Char
' ' forall a. [a] -> [a] -> [a]
++ String
"|"

-- | An \"rounded\" ASCII border box of the given size
roundedAsciiBox :: (Int,Int) -> ASCII
roundedAsciiBox :: (Int, Int) -> ASCII
roundedAsciiBox (Int
x,Int
y) = (Int, Int) -> [String] -> ASCII
ASCII (forall a. Ord a => a -> a -> a
max Int
x Int
2, forall a. Ord a => a -> a -> a
max Int
y Int
2) (String
a forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate (Int
yforall a. Num a => a -> a -> a
-Int
2) String
m forall a. [a] -> [a] -> [a]
++ [String
b]) where
  a :: String
a = String
"/"  forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
xforall a. Num a => a -> a -> a
-Int
2) Char
'-' forall a. [a] -> [a] -> [a]
++ String
"\\"
  m :: String
m = String
"|"  forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
xforall a. Num a => a -> a -> a
-Int
2) Char
' ' forall a. [a] -> [a] -> [a]
++ String
"|"
  b :: String
b = String
"\\" forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
xforall a. Num a => a -> a -> a
-Int
2) Char
'-' forall a. [a] -> [a] -> [a]
++ String
"/"

-- | A box simply filled with the given character
filledBox :: Char -> (Int,Int) -> ASCII
filledBox :: Char -> (Int, Int) -> ASCII
filledBox Char
c (Int
x0,Int
y0) = [String] -> ASCII
asciiFromLines forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
y (forall a. Int -> a -> [a]
replicate Int
x Char
c) where
  x :: Int
x = forall a. Ord a => a -> a -> a
max Int
0 Int
x0
  y :: Int
y = forall a. Ord a => a -> a -> a
max Int
0 Int
y0

-- | A box of spaces
transparentBox :: (Int,Int) -> ASCII
transparentBox :: (Int, Int) -> ASCII
transparentBox = Char -> (Int, Int) -> ASCII
filledBox Char
' '

--------------------------------------------------------------------------------
-- * Testing \/ miscellanea

-- | An integer
asciiNumber :: Int -> ASCII
asciiNumber :: Int -> ASCII
asciiNumber = forall a. Show a => a -> ASCII
asciiShow

asciiShow :: Show a => a -> ASCII
asciiShow :: forall a. Show a => a -> ASCII
asciiShow = [String] -> ASCII
asciiFromLines forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

--------------------------------------------------------------------------------