module Math.Combinat.ASCII where
import Data.Char ( isSpace )
import Data.List ( transpose , intercalate )
import Math.Combinat.Helper
data ASCII = ASCII
{ ASCII -> (Int, Int)
asciiSize :: (Int,Int)
, ASCII -> [String]
asciiLines :: [String]
}
class DrawASCII a where
ascii :: a -> ASCII
instance Show ASCII where
show :: ASCII -> String
show = ASCII -> String
asciiString
emptyRect :: ASCII
emptyRect :: ASCII
emptyRect = (Int, Int) -> [String] -> ASCII
ASCII (Int
0,Int
0) []
asciiXSize, asciiYSize :: ASCII -> Int
asciiXSize :: ASCII -> Int
asciiXSize = (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (ASCII -> (Int, Int)) -> ASCII -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASCII -> (Int, Int)
asciiSize
asciiYSize :: ASCII -> Int
asciiYSize = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (ASCII -> (Int, Int)) -> ASCII -> Int
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 (String -> IO ()) -> (ASCII -> String) -> ASCII -> IO ()
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) (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
f [String]
ls) where
y :: Int
y = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls
x :: Int
x = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls)
f :: ShowS
f String
l = String
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
l) Char
' '
asciiFromString :: String -> ASCII
asciiFromString :: String -> ASCII
asciiFromString = [String] -> ASCII
asciiFromLines ([String] -> ASCII) -> (String -> [String]) -> String -> ASCII
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
data HAlign
= HLeft
| HCenter
| HRight
deriving (HAlign -> HAlign -> Bool
(HAlign -> HAlign -> Bool)
-> (HAlign -> HAlign -> Bool) -> Eq HAlign
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
(Int -> HAlign -> ShowS)
-> (HAlign -> String) -> ([HAlign] -> ShowS) -> Show HAlign
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)
data VAlign
= VTop
| VCenter
| VBottom
deriving (VAlign -> VAlign -> Bool
(VAlign -> VAlign -> Bool)
-> (VAlign -> VAlign -> Bool) -> Eq VAlign
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
(Int -> VAlign -> ShowS)
-> (VAlign -> String) -> ([VAlign] -> ShowS) -> Show VAlign
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
data HSep
= HSepEmpty
| HSepSpaces Int
| HSepString String
deriving Int -> HSep -> ShowS
[HSep] -> ShowS
HSep -> String
(Int -> HSep -> ShowS)
-> (HSep -> String) -> ([HSep] -> ShowS) -> Show HSep
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 -> String -> Int
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 -> Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
k Char
' '
HSepString String
s -> String
s
data VSep
= VSepEmpty
| VSepSpaces Int
| VSepString [Char]
deriving Int -> VSep -> ShowS
[VSep] -> ShowS
VSep -> String
(Int -> VSep -> ShowS)
-> (VSep -> String) -> ([VSep] -> ShowS) -> Show VSep
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 -> String -> Int
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 -> Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
k Char
' '
VSepString String
s -> String
s
(|||) :: ASCII -> ASCII -> ASCII
||| :: ASCII -> ASCII -> ASCII
(|||) ASCII
p ASCII
q = VAlign -> HSep -> [ASCII] -> ASCII
hCatWith VAlign
VCenter HSep
HSepEmpty [ASCII
p,ASCII
q]
(===) :: ASCII -> ASCII -> ASCII
=== :: ASCII -> ASCII -> ASCII
(===) ASCII
p ASCII
q = HAlign -> VSep -> [ASCII] -> ASCII
vCatWith HAlign
HCenter VSep
VSepEmpty [ASCII
p,ASCII
q]
hCatTop :: [ASCII] -> ASCII
hCatTop :: [ASCII] -> ASCII
hCatTop = VAlign -> HSep -> [ASCII] -> ASCII
hCatWith VAlign
VTop HSep
HSepEmpty
hCatBot :: [ASCII] -> ASCII
hCatBot :: [ASCII] -> ASCII
hCatBot = VAlign -> HSep -> [ASCII] -> ASCII
hCatWith VAlign
VBottom HSep
HSepEmpty
vCatLeft :: [ASCII] -> ASCII
vCatLeft :: [ASCII] -> ASCII
vCatLeft = HAlign -> VSep -> [ASCII] -> ASCII
vCatWith HAlign
HLeft VSep
VSepEmpty
vCatRight :: [ASCII] -> ASCII
vCatRight :: [ASCII] -> ASCII
vCatRight = HAlign -> VSep -> [ASCII] -> ASCII
vCatWith HAlign
HRight VSep
VSepEmpty
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 = [ASCII] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ASCII]
rects
maxy :: Int
maxy = [Int] -> Int
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 = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sep
rects1 :: [ASCII]
rects1 = (ASCII -> ASCII) -> [ASCII] -> [ASCII]
forall a b. (a -> b) -> [a] -> [b]
map (VAlign -> Int -> ASCII -> ASCII
vExtendTo VAlign
valign Int
maxy) [ASCII]
rects
x' :: Int
x' = [Int] -> Int
forall a. Num a => [a] -> a
sum' [Int]
xsz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
sepx
final :: [String]
final = ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
sep) ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ [[String]] -> [[String]]
forall a. [[a]] -> [[a]]
transpose ((ASCII -> [String]) -> [ASCII] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ASCII -> [String]
asciiLines [ASCII]
rects1)
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 = [ASCII] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ASCII]
rects
maxx :: Int
maxx = [Int] -> Int
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 = [String] -> [String]
forall a. [[a]] -> [[a]]
transpose (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
maxx (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ VSep -> String
vSepString VSep
vsep) :: [String]
rects1 :: [ASCII]
rects1 = (ASCII -> ASCII) -> [ASCII] -> [ASCII]
forall a b. (a -> b) -> [a] -> [b]
map (HAlign -> Int -> ASCII -> ASCII
hExtendTo HAlign
halign Int
maxx) [ASCII]
rects
y' :: Int
y' = [Int] -> Int
forall a. Num a => [a] -> a
sum' [Int]
ysz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
sepy
final :: [String]
final = [String] -> [[String]] -> [String]
forall a. [a] -> [[a]] -> [a]
intercalate [String]
fullsep ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ (ASCII -> [String]) -> [ASCII] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ASCII -> [String]
asciiLines [ASCII]
rects1
hPad :: Int -> ASCII -> ASCII
hPad :: Int -> ASCII -> ASCII
hPad Int
k (ASCII (Int
x,Int
y) [String]
ls) = (Int, Int) -> [String] -> ASCII
ASCII (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
k,Int
y) (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
f [String]
ls) where
f :: ShowS
f String
l = String
pad String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pad
pad :: String
pad = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
k Char
' '
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
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
k) ([String]
pad [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ls [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
pad) where
pad :: [String]
pad = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
k (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
x Char
' ')
pad :: ASCII -> ASCII
pad :: ASCII -> ASCII
pad = Int -> ASCII -> ASCII
vPad Int
1 (ASCII -> ASCII) -> (ASCII -> ASCII) -> ASCII -> ASCII
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ASCII -> ASCII
hPad Int
2
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 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n0 Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x) ASCII
rect
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 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n0 Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y) ASCII
rect
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
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d,Int
y) (ShowS -> [String] -> [String]
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 String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
d Char
' '
HAlign
HRight -> Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
d Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l
HAlign
HCenter -> Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
a Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
a) Char
' '
a :: Int
a = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
d Int
2
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
yInt -> Int -> Int
forall 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 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
d String
emptyline
VAlign
VBottom -> Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
d String
emptyline [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ls
VAlign
VCenter -> Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
a String
emptyline [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ls [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
a) String
emptyline
a :: Int
a = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
d Int
2
emptyline :: String
emptyline = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
x Char
' '
hIndent :: Int -> ASCII -> ASCII
hIndent :: Int -> ASCII -> ASCII
hIndent Int
d = HAlign -> Int -> ASCII -> ASCII
hExtendWith HAlign
HRight Int
d
vIndent :: Int -> ASCII -> ASCII
vIndent :: Int -> ASCII -> ASCII
vIndent Int
d = VAlign -> Int -> ASCII -> ASCII
vExtendWith VAlign
VBottom Int
d
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) (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
forall a. [a] -> [a]
f [String]
ls) where
x' :: Int
x' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k)
f :: [a] -> [a]
f = case HAlign
halign of
HAlign
HLeft -> [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
k ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse
HAlign
HCenter -> [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
a) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
a
HAlign
HRight -> Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
k
a :: Int
a = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
k Int
2
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') ([String] -> [String]
forall a. [a] -> [a]
g [String]
ls) where
y' :: Int
y' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k)
g :: [a] -> [a]
g = case VAlign
valign of
VAlign
VTop -> [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
k ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse
VAlign
VCenter -> [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
a) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
a
VAlign
VBottom -> Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
k
a :: Int
a = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
k Int
2
pasteOnto :: (Int,Int) -> ASCII -> ASCII -> ASCII
pasteOnto :: (Int, Int) -> ASCII -> ASCII -> ASCII
pasteOnto = (Char -> Bool) -> (Int, Int) -> ASCII -> ASCII -> ASCII
pasteOnto' Char -> Bool
isSpace
pasteOnto'
:: (Char -> Bool)
-> (Int,Int)
-> ASCII
-> ASCII
-> 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
yposInt -> Int -> Bool
forall 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))
(ASCII -> ASCII) -> ASCII -> ASCII
forall a b. (a -> b) -> a -> b
$ (if (Int
xposInt -> Int -> Bool
forall 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))
(ASCII -> ASCII) -> ASCII -> ASCII
forall a b. (a -> b) -> a -> b
$ ASCII
small
smallLines :: [String]
smallLines = ASCII -> [String]
asciiLines ASCII
small'
lines' :: [String]
lines' = (String -> ShowS) -> [String] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> ShowS
f [String]
bigLines ([String]
smallLines [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
forall a. a -> [a]
repeat String
"")
f :: String -> ShowS
f String
bl String
sl = (Char -> Char -> Char) -> String -> ShowS
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Char -> Char -> Char
g String
bl (String
sl String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
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
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
xsize Int
2
HAlign
HRight -> Int
xpos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
xsize
ypos' :: Int
ypos' = case VAlign
valign of
VAlign
VTop -> Int
ypos
VAlign
VCenter -> Int
ypos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
ysize Int
2
VAlign
VBottom -> Int
ypos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ysize
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 = [[ASCII]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[ASCII]]
rects0
m :: Int
m = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (([ASCII] -> Int) -> [[ASCII]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [ASCII] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[ASCII]]
rects0)
rects1 :: [[ASCII]]
rects1 = ([ASCII] -> [ASCII]) -> [[ASCII]] -> [[ASCII]]
forall a b. (a -> b) -> [a] -> [b]
map (\[ASCII]
rs -> [ASCII]
rs [ASCII] -> [ASCII] -> [ASCII]
forall a. [a] -> [a] -> [a]
++ Int -> ASCII -> [ASCII]
forall a. Int -> a -> [a]
replicate (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- [ASCII] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ASCII]
rs) ASCII
emptyRect) [[ASCII]]
rects0
ys :: [Int]
ys = ([ASCII] -> Int) -> [[ASCII]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\[ASCII]
rs -> [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((ASCII -> Int) -> [ASCII] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ASCII -> Int
asciiYSize [ASCII]
rs)) [[ASCII]]
rects1
xs :: [Int]
xs = ([ASCII] -> Int) -> [[ASCII]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\[ASCII]
rs -> [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((ASCII -> Int) -> [ASCII] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ASCII -> Int
asciiXSize [ASCII]
rs)) ([[ASCII]] -> [[ASCII]]
forall a. [[a]] -> [[a]]
transpose [[ASCII]]
rects1)
rects2 :: [[ASCII]]
rects2 = ([ASCII] -> [ASCII]) -> [[ASCII]] -> [[ASCII]]
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 ) <- [Int] -> [ASCII] -> [(Int, ASCII)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
xs [ASCII]
rs ]) [[ASCII]]
rects1
rects3 :: [[ASCII]]
rects3 = [ (ASCII -> ASCII) -> [ASCII] -> [ASCII]
forall a b. (a -> b) -> [a] -> [b]
map (VAlign -> Int -> ASCII -> ASCII
vExtendTo VAlign
valign Int
y) [ASCII]
rs | (Int
y,[ASCII]
rs) <- [Int] -> [[ASCII]] -> [(Int, [ASCII])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ys [[ASCII]]
rects2 ]
final :: ASCII
final = HAlign -> VSep -> [ASCII] -> ASCII
vCatWith HAlign
HLeft VSep
vsep
([ASCII] -> ASCII) -> [ASCII] -> ASCII
forall a b. (a -> b) -> a -> b
$ ([ASCII] -> ASCII) -> [[ASCII]] -> [ASCII]
forall a b. (a -> b) -> [a] -> [b]
map (VAlign -> HSep -> [ASCII] -> ASCII
hCatWith VAlign
VTop HSep
hsep) [[ASCII]]
rects3
data MatrixOrder
= RowMajor
| ColMajor
deriving (MatrixOrder -> MatrixOrder -> Bool
(MatrixOrder -> MatrixOrder -> Bool)
-> (MatrixOrder -> MatrixOrder -> Bool) -> Eq MatrixOrder
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
Eq MatrixOrder
-> (MatrixOrder -> MatrixOrder -> Ordering)
-> (MatrixOrder -> MatrixOrder -> Bool)
-> (MatrixOrder -> MatrixOrder -> Bool)
-> (MatrixOrder -> MatrixOrder -> Bool)
-> (MatrixOrder -> MatrixOrder -> Bool)
-> (MatrixOrder -> MatrixOrder -> MatrixOrder)
-> (MatrixOrder -> MatrixOrder -> MatrixOrder)
-> Ord 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
$cp1Ord :: Eq MatrixOrder
Ord,Int -> MatrixOrder -> ShowS
[MatrixOrder] -> ShowS
MatrixOrder -> String
(Int -> MatrixOrder -> ShowS)
-> (MatrixOrder -> String)
-> ([MatrixOrder] -> ShowS)
-> Show MatrixOrder
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]
(Int -> ReadS MatrixOrder)
-> ReadS [MatrixOrder]
-> ReadPrec MatrixOrder
-> ReadPrec [MatrixOrder]
-> Read 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)
autoTabulate
:: MatrixOrder
-> Either Int Int
-> [ASCII]
-> 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 = [ASCII] -> Int
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 -> [[ASCII]] -> [[ASCII]]
forall a. [[a]] -> [[a]]
transpose (Int -> [ASCII] -> [[ASCII]]
forall a. Int -> [a] -> [[a]]
parts Int
y [ASCII]
list)
MatrixOrder
RowMajor -> Int -> [ASCII] -> [[ASCII]]
forall a. Int -> [a] -> [[a]]
invparts Int
y [ASCII]
list
Right Int
x -> case MatrixOrder
mtxorder of
MatrixOrder
ColMajor -> [[ASCII]] -> [[ASCII]]
forall a. [[a]] -> [[a]]
transpose (Int -> [ASCII] -> [[ASCII]]
forall a. Int -> [a] -> [[a]]
invparts Int
x [ASCII]
list)
MatrixOrder
RowMajor -> Int -> [ASCII] -> [[ASCII]]
forall a. Int -> [a] -> [[a]]
parts Int
x [ASCII]
list
transposeIf :: Bool -> [[a]] -> [[a]]
transposeIf Bool
b = if Bool
b then [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
transpose else [[a]] -> [[a]]
forall a. a -> a
id
parts :: Int -> [a] -> [[a]]
parts Int
d = [a] -> [[a]]
forall a. [a] -> [[a]]
go where
go :: [a] -> [[a]]
go [] = []
go [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
d [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
go (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
d [a]
xs)
invparts :: Int -> [a] -> [[a]]
invparts Int
d [a]
xs = [Int] -> [a] -> [[a]]
forall a. [Int] -> [a] -> [[a]]
parts' [Int]
ds [a]
xs where
(Int
q,Int
r) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod Int
n Int
d
ds :: [Int]
ds = Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
r (Int
qInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r) Int
q
parts' :: [Int] -> [a] -> [[a]]
parts' [Int]
ds [a]
xs = [Int] -> [a] -> [[a]]
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 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
d [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [Int] -> [a] -> [[a]]
go [Int]
ds (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
d [a]
xs)
caption :: String -> ASCII -> ASCII
caption :: String -> ASCII -> ASCII
caption = Bool -> HAlign -> String -> ASCII -> ASCII
caption' Bool
False HAlign
HLeft
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
asciiBox :: (Int,Int) -> ASCII
asciiBox :: (Int, Int) -> ASCII
asciiBox (Int
x,Int
y) = (Int, Int) -> [String] -> ASCII
ASCII (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x Int
2, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
y Int
2) (String
h String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) String
m [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
h]) where
h :: String
h = String
"+" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) Char
'-' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"+"
m :: String
m = String
"|" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"|"
roundedAsciiBox :: (Int,Int) -> ASCII
roundedAsciiBox :: (Int, Int) -> ASCII
roundedAsciiBox (Int
x,Int
y) = (Int, Int) -> [String] -> ASCII
ASCII (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x Int
2, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
y Int
2) (String
a String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) String
m [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
b]) where
a :: String
a = String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) Char
'-' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\"
m :: String
m = String
"|" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"|"
b :: String
b = String
"\\" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) Char
'-' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/"
filledBox :: Char -> (Int,Int) -> ASCII
filledBox :: Char -> (Int, Int) -> ASCII
filledBox Char
c (Int
x0,Int
y0) = [String] -> ASCII
asciiFromLines ([String] -> ASCII) -> [String] -> ASCII
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
y (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
x Char
c) where
x :: Int
x = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
x0
y :: Int
y = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
y0
transparentBox :: (Int,Int) -> ASCII
transparentBox :: (Int, Int) -> ASCII
transparentBox = Char -> (Int, Int) -> ASCII
filledBox Char
' '
asciiNumber :: Int -> ASCII
asciiNumber :: Int -> ASCII
asciiNumber = Int -> ASCII
forall a. Show a => a -> ASCII
asciiShow
asciiShow :: Show a => a -> ASCII
asciiShow :: a -> ASCII
asciiShow = [String] -> ASCII
asciiFromLines ([String] -> ASCII) -> (a -> [String]) -> a -> ASCII
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String]) -> (a -> String) -> a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show