module Math.Combinat.ASCII where
import Data.List
import Math.Combinat.Helper
data ASCII = ASCII
{ asciiSize :: (Int,Int)
, asciiLines :: [String]
}
class DrawASCII a where
ascii :: a -> ASCII
instance Show ASCII where
show = asciiString
emptyRect :: ASCII
emptyRect = ASCII (0,0) []
asciiXSize, asciiYSize :: ASCII -> Int
asciiXSize = fst . asciiSize
asciiYSize = snd . asciiSize
asciiString :: ASCII -> String
asciiString (ASCII sz ls) = unlines ls
printASCII :: ASCII -> IO ()
printASCII = putStrLn . asciiString
asciiFromLines :: [String] -> ASCII
asciiFromLines ls = ASCII (x,y) (map f ls) where
y = length ls
x = maximum (map length ls)
f l = l ++ replicate (x length l) ' '
asciiFromString :: String -> ASCII
asciiFromString = asciiFromLines . lines
data HAlign
= HLeft
| HCenter
| HRight
deriving (Eq,Show)
data VAlign
= VTop
| VCenter
| VBottom
deriving (Eq,Show)
data Alignment = Align HAlign VAlign
hExtendTo :: HAlign -> Int -> ASCII -> ASCII
hExtendTo halign n0 rect@(ASCII (x,y) ls) = hExtendWith halign (max n0 x x) rect
vExtendTo :: VAlign -> Int -> ASCII -> ASCII
vExtendTo valign n0 rect@(ASCII (x,y) ls) = vExtendWith valign (max n0 y y) rect
hExtendWith :: HAlign -> Int -> ASCII -> ASCII
hExtendWith alignment d (ASCII (x,y) ls) = ASCII (x+d,y) (map f ls) where
f l = case alignment of
HLeft -> l ++ replicate d ' '
HRight -> replicate d ' ' ++ l
HCenter -> replicate a ' ' ++ l ++ replicate (da) ' '
a = div d 2
vExtendWith :: VAlign -> Int -> ASCII -> ASCII
vExtendWith valign d (ASCII (x,y) ls) = ASCII (x,y+d) (f ls) where
f ls = case valign of
VTop -> ls ++ replicate d emptyline
VBottom -> replicate d emptyline ++ ls
VCenter -> replicate a emptyline ++ ls ++ replicate (da) emptyline
a = div d 2
emptyline = replicate x ' '
hIndent :: Int -> ASCII -> ASCII
hIndent d = hExtendWith HRight d
vIndent :: Int -> ASCII -> ASCII
vIndent d = vExtendWith VBottom d
data HSep
= HSepEmpty
| HSepSpaces Int
| HSepString String
deriving Show
hSepSize :: HSep -> Int
hSepSize hsep = case hsep of
HSepEmpty -> 0
HSepSpaces k -> k
HSepString s -> length s
hSepString :: HSep -> String
hSepString hsep = case hsep of
HSepEmpty -> ""
HSepSpaces k -> replicate k ' '
HSepString s -> s
data VSep
= VSepEmpty
| VSepSpaces Int
| VSepString [Char]
deriving Show
vSepSize :: VSep -> Int
vSepSize vsep = case vsep of
VSepEmpty -> 0
VSepSpaces k -> k
VSepString s -> length s
vSepString :: VSep -> [Char]
vSepString vsep = case vsep of
VSepEmpty -> []
VSepSpaces k -> replicate k ' '
VSepString s -> s
hPad :: Int -> ASCII -> ASCII
hPad k (ASCII (x,y) ls) = ASCII (x+2*k,y) (map f ls) where
f l = pad ++ l ++ pad
pad = replicate k ' '
vPad :: Int -> ASCII -> ASCII
vPad k (ASCII (x,y) ls) = ASCII (x,y+2*k) (pad ++ ls ++ pad) where
pad = replicate k (replicate x ' ')
pad :: ASCII -> ASCII
pad = vPad 1 . hPad 2
hCatWith :: VAlign -> HSep -> [ASCII] -> ASCII
hCatWith valign hsep rects = ASCII (x',maxy) final where
n = length rects
maxy = maximum [ y | ASCII (_,y) _ <- rects ]
xsz = [ x | ASCII (x,_) _ <- rects ]
sep = hSepString hsep
sepx = length sep
rects1 = map (vExtendTo valign maxy) rects
x' = sum' xsz + (n1)*sepx
final = map (intercalate sep) $ transpose (map asciiLines rects1)
vCatWith :: HAlign -> VSep -> [ASCII] -> ASCII
vCatWith halign vsep rects = ASCII (maxx,y') final where
n = length rects
maxx = maximum [ x | ASCII (x,_) _ <- rects ]
ysz = [ y | ASCII (_,y) _ <- rects ]
sepy = vSepSize vsep
fullsep = transpose (replicate maxx $ vSepString vsep) :: [String]
rects1 = map (hExtendTo halign maxx) rects
y' = sum' ysz + (n1)*sepy
final = intercalate fullsep $ map asciiLines rects1
tabulate :: (HAlign,VAlign) -> (HSep,VSep) -> [[ASCII]] -> ASCII
tabulate (halign,valign) (hsep,vsep) rects0 = final where
n = length rects0
m = maximum (map length rects0)
rects1 = map (\rs -> rs ++ replicate (m length rs) emptyRect) rects0
ys = map (\rs -> maximum (map asciiYSize rs)) rects1
xs = map (\rs -> maximum (map asciiXSize rs)) (transpose rects1)
rects2 = map (\rs -> [ hExtendTo halign x r | (x,r ) <- zip xs rs ]) rects1
rects3 = [ map (vExtendTo valign y) rs | (y,rs) <- zip ys rects2 ]
final = vCatWith HLeft vsep
$ map (hCatWith VTop hsep) rects3
data MatrixOrder
= RowMajor
| ColMajor
deriving (Eq,Ord,Show,Read)
autoTabulate
:: MatrixOrder
-> Either Int Int
-> [ASCII]
-> ASCII
autoTabulate mtxorder ei list = final where
final = tabulate (HLeft,VBottom) (HSepSpaces 2,VSepSpaces 1) rects
n = length list
rects = case ei of
Left y -> case mtxorder of
ColMajor -> transpose (parts y list)
RowMajor -> invparts y list
Right x -> case mtxorder of
ColMajor -> transpose (invparts x list)
RowMajor -> parts x list
transposeIf b = if b then transpose else id
parts d = go where
go [] = []
go xs = take d xs : go (drop d xs)
invparts d xs = parts' ds xs where
(q,r) = divMod n d
ds = replicate r (q+1) ++ replicate (dr) q
parts' ds xs = go ds xs where
go _ [] = []
go [] _ = []
go (d:ds) xs = take d xs : go ds (drop d xs)
caption :: String -> ASCII -> ASCII
caption = caption' False HLeft
caption' :: Bool -> HAlign -> String -> ASCII -> ASCII
caption' emptyline halign str rect = vCatWith halign sep [rect,capt] where
sep = if emptyline then VSepSpaces 1 else VSepEmpty
capt = asciiFromString str
asciiBox :: (Int,Int) -> ASCII
asciiBox (x,y) = ASCII (max x 2, max y 2) (h : replicate (y2) m ++ [h]) where
h = "+" ++ replicate (x2) '-' ++ "+"
m = "|" ++ replicate (x2) ' ' ++ "|"
roundedAsciiBox :: (Int,Int) -> ASCII
roundedAsciiBox (x,y) = ASCII (max x 2, max y 2) (a : replicate (y2) m ++ [b]) where
a = "/" ++ replicate (x2) '-' ++ "\\"
m = "|" ++ replicate (x2) ' ' ++ "|"
b = "\\" ++ replicate (x2) '-' ++ "/"
asciiNumber :: Int -> ASCII
asciiNumber = asciiShow
asciiShow :: Show a => a -> ASCII
asciiShow = asciiFromLines . (:[]) . show