{-# LANGUAGE RecordWildCards #-}
module Potato.Flow.Methods.TextCommon (
displayLinesToChar
) where
import Relude
import Potato.Flow.Serialization.Snake
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified Potato.Data.Text.Zipper as TZ
concatSpans :: [TZ.Span a] -> Text
concatSpans :: forall a. [Span a] -> Text
concatSpans [Span a]
spans = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Span a -> Text) -> [Span a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TZ.Span a
_ Text
t) -> Text
t) [Span a]
spans
subWidth :: Text -> [Maybe Char]
subWidth :: Text -> [Maybe Char]
subWidth Text
t = [[Maybe Char]] -> [Maybe Char]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Maybe Char]] -> [Maybe Char])
-> (Text -> [[Maybe Char]]) -> Text -> [Maybe Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Maybe Char]) -> [Char] -> [[Maybe Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> [Maybe Char]
fn ([Char] -> [[Maybe Char]])
-> (Text -> [Char]) -> Text -> [[Maybe Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> [Maybe Char]) -> Text -> [Maybe Char]
forall a b. (a -> b) -> a -> b
$ Text
t where
fn :: Char -> [Maybe Char]
fn Char
c = case Char -> Int
TZ.charWidth Char
c of
Int
1 -> [Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c]
Int
2 -> [Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c, Maybe Char
forall a. Maybe a
Nothing]
Int
n -> [Maybe Char
forall a. Maybe a
Nothing]
displayLinesToChar ::
(Int, Int)
-> TZ.DisplayLines Int
-> (Int, Int)
-> (Int, Int)
-> Maybe MPChar
displayLinesToChar :: (Int, Int)
-> DisplayLines Int
-> (Int, Int)
-> (Int, Int)
-> Maybe (Maybe Char)
displayLinesToChar (Int
x, Int
y) DisplayLines Int
dl (Int
x',Int
y') (Int
xoff, Int
yoff) = Maybe (Maybe Char)
outputChar where
spans :: [[Span Int]]
spans = DisplayLines Int -> [[Span Int]]
forall tag. DisplayLines tag -> [[Span tag]]
TZ._displayLines_spans DisplayLines Int
dl
offsetMap :: OffsetMapWithAlignment
offsetMap = DisplayLines Int -> OffsetMapWithAlignment
forall tag. DisplayLines tag -> OffsetMapWithAlignment
TZ._displayLines_offsetMap DisplayLines Int
dl
yidx :: Int
yidx = Int
y' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
yoff
xalignoffset :: Int
xalignoffset = case Int -> OffsetMapWithAlignment -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
yidx OffsetMapWithAlignment
offsetMap of
Maybe (Int, Int)
Nothing -> -Int
1
Just (Int
offset,Int
_) -> Int
offset
outputChar :: Maybe (Maybe Char)
outputChar = case [[Span Int]]
spans [[Span Int]] -> Int -> Maybe [Span Int]
forall a. [a] -> Int -> Maybe a
!!? Int
yidx of
Maybe [Span Int]
Nothing -> Maybe (Maybe Char)
forall a. Maybe a
Nothing
Just [Span Int]
row -> Maybe (Maybe Char)
outputChar' where
rowText :: [Maybe Char]
rowText = Text -> [Maybe Char]
subWidth (Text -> [Maybe Char]) -> Text -> [Maybe Char]
forall a b. (a -> b) -> a -> b
$ [Span Int] -> Text
forall a. [Span a] -> Text
concatSpans [Span Int]
row
xidx :: Int
xidx = Int
x' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xoff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xalignoffset
outputChar' :: Maybe (Maybe Char)
outputChar' = case [Maybe Char]
rowText [Maybe Char] -> Int -> Maybe (Maybe Char)
forall a. [a] -> Int -> Maybe a
!!? Int
xidx of
Maybe (Maybe Char)
Nothing -> Maybe (Maybe Char)
forall a. Maybe a
Nothing
Just Maybe Char
cell -> Maybe Char -> Maybe (Maybe Char)
forall a. a -> Maybe a
Just Maybe Char
cell