module System.Console.Ansigraph.Internal.Matrix (
matShow
, displayMat
, displayCMat
) where
import System.Console.Ansigraph.Internal.Core
import Data.Complex
import Data.List (intersperse)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Applicative
mmap :: (a -> b) -> [[a]] -> [[b]]
mmap = map . map
mmax :: (Num a, Ord a) => [[a]] -> a
mmax = maximum . map maximum . mmap abs
densityChars = "█▓▒░"
densityVals :: [Double]
densityVals = (+ 0.125) . (/4) <$> [3,2,1,0]
blocks :: [(Double,Char)]
blocks = zip densityVals densityChars
data MatElement = MatElement !Bool !Char
elemChar :: MatElement -> Char
elemChar (MatElement _ c) = c
putRealElement :: MonadIO m => GraphSettings -> MatElement -> m ()
putRealElement s (MatElement b c) = colorStr clring (c : " ")
where clr = if b then realNegColor s else realColor s
clring = mkColoring clr (realBG s)
putImagElement :: MonadIO m => GraphSettings -> MatElement -> m ()
putImagElement s (MatElement b c) = colorStr clring $ c : " "
where clr = if b then imagNegColor s else imagColor s
clring = mkColoring clr (imagBG s)
selectMatElement :: Double -> MatElement
selectMatElement x = let l = filter (\p -> fst p < abs x) blocks in case l of
[] -> MatElement False ' '
(p:_) -> MatElement (x < 0) (snd p)
matElements :: [[Double]] -> [[MatElement]]
matElements m = let mx = mmax m
in mmap (selectMatElement . (/ mx)) m
matShow :: [[Double]] -> [String]
matShow = mmap elemChar . matElements
newline = putStrLn' ""
intersperse' x l = intersperse x l ++ [x]
displayMat :: MonadIO m => GraphSettings -> [[Double]] -> m ()
displayMat s = liftIO . sequence_ . concat . intersperse' [newline] . displayRealMat s
displayRealMat :: MonadIO m => GraphSettings -> [[Double]] -> [[m ()]]
displayRealMat s = mmap (putRealElement s) . matElements
displayImagMat :: MonadIO m => GraphSettings -> [[Double]] -> [[m ()]]
displayImagMat s = mmap (putImagElement s) . matElements
displayCMat :: MonadIO m => GraphSettings -> [[Complex Double]] -> m ()
displayCMat s m = liftIO . sequence_ . concat . intersperse' [newline] $
zipWith (\xs ys -> xs ++ putStr " " : ys)
(displayRealMat s $ mmap realPart m)
(displayImagMat s $ mmap imagPart m)