-- TODO DEPRECATE this file

{-# LANGUAGE RecordWildCards #-}

-- TODO rename to common
module Potato.Flow.Methods.Types where


import           Relude

import           Potato.Flow.Math
import           Potato.Flow.Owl
import           Potato.Flow.Serialization.Snake

import qualified Data.Text         as T


-- TODO get rid of (HasOwlTree a) arg, this can be passed in at the getDrawer level instead!
type SEltDrawerRenderFn = forall a. (HasOwlTree a) => a -> XY -> Maybe PChar
-- returns minimal bounding LBox. Does NOT include expanded box due to wide chars
type SEltDrawerBoxFn = forall a. (HasOwlTree a) => a -> LBox


makePotatoRenderer :: LBox -> SEltDrawerRenderFn
makePotatoRenderer :: LBox -> SEltDrawerRenderFn
makePotatoRenderer LBox
lbox a
_ XY
pt = if LBox -> XY -> Bool
does_lBox_contains_XY LBox
lbox XY
pt
  then PChar -> Maybe PChar
forall a. a -> Maybe a
Just PChar
'#'
  else Maybe PChar
forall a. Maybe a
Nothing


data SEltDrawer = SEltDrawer {

  -- TODO renameto boxFn
  SEltDrawer -> SEltDrawerBoxFn
_sEltDrawer_box        :: SEltDrawerBoxFn

  , SEltDrawer -> SEltDrawerRenderFn
_sEltDrawer_renderFn :: SEltDrawerRenderFn

  , SEltDrawer -> Int
_sEltDrawer_maxCharWidth :: Int

  --, _sEltDrawer_renderToBoxFn :: LBox -> Vector PChar -- consider this version for better performance
}

nilDrawer :: SEltDrawer
nilDrawer :: SEltDrawer
nilDrawer = SEltDrawer {
    -- maybe retun type of _sEltDrawer_box should be Maybe LBox?
    _sEltDrawer_box :: SEltDrawerBoxFn
_sEltDrawer_box = LBox -> a -> LBox
forall a b. a -> b -> a
const LBox
nilLBox
    , _sEltDrawer_renderFn :: SEltDrawerRenderFn
_sEltDrawer_renderFn = \a
_ XY
_ -> Maybe PChar
forall a. Maybe a
Nothing
    , _sEltDrawer_maxCharWidth :: Int
_sEltDrawer_maxCharWidth = Int
1
  }

sEltDrawer_renderToLines :: (HasOwlTree a) => SEltDrawer -> a -> [Text]
sEltDrawer_renderToLines :: forall a. HasOwlTree a => SEltDrawer -> a -> [Text]
sEltDrawer_renderToLines SEltDrawer {Int
SEltDrawerBoxFn
SEltDrawerRenderFn
_sEltDrawer_box :: SEltDrawer -> SEltDrawerBoxFn
_sEltDrawer_renderFn :: SEltDrawer -> SEltDrawerRenderFn
_sEltDrawer_maxCharWidth :: SEltDrawer -> Int
_sEltDrawer_box :: SEltDrawerBoxFn
_sEltDrawer_renderFn :: SEltDrawerRenderFn
_sEltDrawer_maxCharWidth :: Int
..} a
ot = [Text]
r where
  LBox (V2 Int
sx Int
sy) (V2 Int
w Int
h) = a -> LBox
SEltDrawerBoxFn
_sEltDrawer_box a
ot
  pts :: [[(Int, Int)]]
pts = [[(Int
x,Int
y) | Int
x <- [Int
0..Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]| Int
y <- [Int
0..Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
  r' :: [[PChar]]
r' = ([(Int, Int)] -> [PChar]) -> [[(Int, Int)]] -> [[PChar]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, Int) -> PChar) -> [(Int, Int)] -> [PChar]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
x,Int
y) -> PChar -> Maybe PChar -> PChar
forall a. a -> Maybe a -> a
fromMaybe PChar
' ' (a -> XY -> Maybe PChar
SEltDrawerRenderFn
_sEltDrawer_renderFn a
ot (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (Int
sxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
x) (Int
syInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y))))) [[(Int, Int)]]
pts
  r :: [Text]
r = ([PChar] -> Text) -> [[PChar]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [PChar] -> Text
T.pack [[PChar]]
r'



{-
TODO something like this
data CachedAreaDrawer = CachedAreaDrawer {
  _cachedAreaDrawer_box :: LBox
  , _cachedAreaDrawer_cache :: V.Vector (Maybe PChar) -- ^ row major
}-}



-- TODO DEPRECATE doesn't account for attached stuff
-- TODO rename to getSEltBoundingBox or something
-- | gets an 'LBox' that contains the entire RElt
getSEltBox_naive :: SElt -> Maybe LBox
getSEltBox_naive :: SElt -> Maybe LBox
getSEltBox_naive SElt
selt = case SElt
selt of
  SElt
SEltNone        -> Maybe LBox
forall a. Maybe a
Nothing
  SElt
SEltFolderStart -> Maybe LBox
forall a. Maybe a
Nothing
  SElt
SEltFolderEnd   -> Maybe LBox
forall a. Maybe a
Nothing
  SEltBox SBox
x       -> LBox -> Maybe LBox
forall a. a -> Maybe a
Just (LBox -> Maybe LBox) -> LBox -> Maybe LBox
forall a b. (a -> b) -> a -> b
$ LBox -> LBox
canonicalLBox_from_lBox_ (LBox -> LBox) -> LBox -> LBox
forall a b. (a -> b) -> a -> b
$ SBox -> LBox
_sBox_box SBox
x

  -- UNTESTED
  SEltLine SAutoLine
x      -> LBox -> Maybe LBox
forall a. a -> Maybe a
Just LBox
r where
    midpoints :: [XY]
midpoints = (SAutoLineConstraint -> XY) -> [SAutoLineConstraint] -> [XY]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(SAutoLineConstraintFixed XY
c) -> XY
c) (SAutoLine -> [SAutoLineConstraint]
_sAutoLine_midpoints SAutoLine
x)
    r :: LBox
r = [XY] -> LBox
make_lBox_from_XYlist ([XY] -> LBox) -> [XY] -> LBox
forall a b. (a -> b) -> a -> b
$ (SAutoLine -> XY
_sAutoLine_start SAutoLine
x) XY -> [XY] -> [XY]
forall a. a -> [a] -> [a]
: (SAutoLine -> XY
_sAutoLine_end SAutoLine
x) XY -> [XY] -> [XY]
forall a. a -> [a] -> [a]
: (SAutoLine -> XY
_sAutoLine_start SAutoLine
x XY -> XY -> XY
forall a. Num a => a -> a -> a
+ XY
1) XY -> [XY] -> [XY]
forall a. a -> [a] -> [a]
: (SAutoLine -> XY
_sAutoLine_end SAutoLine
x XY -> XY -> XY
forall a. Num a => a -> a -> a
+ XY
1) XY -> [XY] -> [XY]
forall a. a -> [a] -> [a]
: [XY]
midpoints

  SEltTextArea STextArea
x      -> LBox -> Maybe LBox
forall a. a -> Maybe a
Just (LBox -> Maybe LBox) -> LBox -> Maybe LBox
forall a b. (a -> b) -> a -> b
$ LBox -> LBox
canonicalLBox_from_lBox_ (LBox -> LBox) -> LBox -> LBox
forall a b. (a -> b) -> a -> b
$ STextArea -> LBox
_sTextArea_box STextArea
x

getSEltLabelBox :: SEltLabel -> Maybe LBox
getSEltLabelBox :: SEltLabel -> Maybe LBox
getSEltLabelBox (SEltLabel Text
_ SElt
x) = SElt -> Maybe LBox
getSEltBox_naive SElt
x