{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Methods.TextCommon (
  displayLinesToChar
) where

import           Relude

import           Potato.Flow.Math
import           Potato.Flow.SElts


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 = forall a. Monoid a => [a] -> a
mconcat 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 = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> [Maybe Char]
fn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack 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 -> [forall a. a -> Maybe a
Just Char
c]
    Int
2 -> [forall a. a -> Maybe a
Just Char
c, forall a. Maybe a
Nothing]
    Int
n -> forall a. String -> a -> a
trace (String
"unexpected char " forall a. Semigroup a => a -> a -> a
<> [Char
c] forall a. Semigroup a => a -> a -> a
<> String
" of width " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Int
n) [forall a. Maybe a
Nothing]


displayLinesToChar ::
  (Int, Int) -- ^ the upper left corner of the box containing the text we want to render
  -> TZ.DisplayLines Int -- ^ pre-generated displaylines
  -> (Int, Int) -- ^ the point we want to render
  -> (Int, Int) -- ^ how much text is offest by
  -> 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 = forall tag. DisplayLines tag -> [[Span tag]]
TZ._displayLines_spans DisplayLines Int
dl
  offsetMap :: OffsetMapWithAlignment
offsetMap = forall tag. DisplayLines tag -> OffsetMapWithAlignment
TZ._displayLines_offsetMap DisplayLines Int
dl
  yidx :: Int
yidx = Int
y' forall a. Num a => a -> a -> a
- Int
y forall a. Num a => a -> a -> a
- Int
yoff
  xalignoffset :: Int
xalignoffset = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
yidx OffsetMapWithAlignment
offsetMap of
    Maybe (Int, Int)
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"should not happen. got " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Int
yidx forall a. Semigroup a => a -> a -> a
<> Text
" in\n" forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show DisplayLines Int
dl forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show [[Span Int]]
spans
    Just (Int
offset,Int
_) -> Int
offset
  outputChar :: Maybe (Maybe Char)
outputChar = case [[Span Int]]
spans forall a. [a] -> Int -> Maybe a
!!? Int
yidx of
    Maybe [Span Int]
Nothing -> forall a. Maybe a
Nothing
    Just [Span Int]
row -> Maybe (Maybe Char)
outputChar' where
      rowText :: [Maybe Char]
rowText = Text -> [Maybe Char]
subWidth forall a b. (a -> b) -> a -> b
$ forall a. [Span a] -> Text
concatSpans [Span Int]
row
      xidx :: Int
xidx = Int
x' forall a. Num a => a -> a -> a
- Int
x forall a. Num a => a -> a -> a
- Int
xoff forall a. Num a => a -> a -> a
- Int
xalignoffset
      outputChar' :: Maybe (Maybe Char)
outputChar' = case [Maybe Char]
rowText forall a. [a] -> Int -> Maybe a
!!? Int
xidx of
        Maybe (Maybe Char)
Nothing   -> forall a. Maybe a
Nothing
        Just Maybe Char
cell -> forall a. a -> Maybe a
Just Maybe Char
cell