{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.RenderCache where

import           Relude

import           Potato.Flow.Math
import           Potato.Flow.Methods.Types
import           Potato.Flow.Serialization.Snake
import Potato.Flow.Types
import Potato.Flow.Owl
import           Potato.Flow.Methods.LineTypes


import qualified Data.IntMap             as IM
import qualified Data.Text.IO as T
import qualified Data.Vector.Unboxed     as V
import Control.Exception (assert)

-- TODO move these methods to Math
-- | input index must be contained in the box
toPoint :: LBox -> Int -> XY
toPoint :: LBox -> Int -> XY
toPoint (LBox (V2 Int
x Int
y) (V2 Int
w Int
_)) Int
i = Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x) (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)

-- | input XY point must be contained in the box
toIndex :: LBox -> XY -> Int
toIndex :: LBox -> XY -> Int
toIndex (LBox (V2 Int
x Int
y) (V2 Int
w Int
_)) (V2 Int
px Int
py) = (Int
pyInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
y)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
pxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x)

-- | same as above but does bounds checking
toIndexSafe :: LBox -> XY -> Maybe Int
toIndexSafe :: LBox -> XY -> Maybe Int
toIndexSafe LBox
lbx XY
xy = if LBox -> XY -> Bool
does_lBox_contains_XY LBox
lbx XY
xy
  then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ LBox -> XY -> Int
toIndex LBox
lbx XY
xy
  else Maybe Int
forall a. Maybe a
Nothing



-- | WidePChar represents part of a PChar that
-- the Int8 parameter is offset from where the PChar originates from, so for example
-- '😱' <- PChar
--  01 <- Int8 offset parameter
--
-- -1 value for offset means there is no character in the space, the PChar value is ignored in this case
type MWidePChar = (Int8, PChar)

emptyMWidePChar :: MWidePChar 
emptyMWidePChar :: MWidePChar
emptyMWidePChar = (-Int8
1, Char
' ') -- ' ' is a dummy character needed to pad the unboxed vector

-- TODO consider making sparse variant
-- | the LBox may exceed the logical bounding box of the object that is being represented if that object contains wide chars
data PreRender = PreRender (V.Vector (MWidePChar)) LBox deriving (Int -> PreRender -> ShowS
[PreRender] -> ShowS
PreRender -> String
(Int -> PreRender -> ShowS)
-> (PreRender -> String)
-> ([PreRender] -> ShowS)
-> Show PreRender
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PreRender -> ShowS
showsPrec :: Int -> PreRender -> ShowS
$cshow :: PreRender -> String
show :: PreRender -> String
$cshowList :: [PreRender] -> ShowS
showList :: [PreRender] -> ShowS
Show)

emptyPreRender :: PreRender
emptyPreRender :: PreRender
emptyPreRender = Vector MWidePChar -> LBox -> PreRender
PreRender Vector MWidePChar
forall a. Unbox a => Vector a
V.empty (XY -> XY -> LBox
LBox XY
0 XY
0)

preRender_lookup :: (HasCallStack) => PreRender -> XY -> MWidePChar
preRender_lookup :: HasCallStack => PreRender -> XY -> MWidePChar
preRender_lookup (PreRender Vector MWidePChar
v LBox
lbox) XY
pos = MWidePChar
r where
  -- we still have to do this check here since toIndex expects point to be contained in box
  r :: MWidePChar
r = if LBox -> XY -> Bool
does_lBox_contains_XY LBox
lbox XY
pos 
    then case Vector MWidePChar
v Vector MWidePChar -> Int -> Maybe MWidePChar
forall a. Unbox a => Vector a -> Int -> Maybe a
V.!? (LBox -> XY -> Int
toIndex LBox
lbox XY
pos) of
      Maybe MWidePChar
Nothing -> Bool -> MWidePChar -> MWidePChar
forall a. HasCallStack => Bool -> a -> a
assert Bool
False MWidePChar
emptyMWidePChar
      Just MWidePChar
x -> MWidePChar
x
    else MWidePChar
emptyMWidePChar


-- NOTE OwlIteCache is intended to be used at several stages in the event loop
-- it can be used in Handlers, it can be used when generating SEltDrawers and it can be used for rendering itself
data OwlItemCache =
  -- TODO change to LineAnchorsForRenderList prob
  OwlItemCache_Line LineAnchorsForRender PreRender
  | OwlItemCache_Generic PreRender deriving (Int -> OwlItemCache -> ShowS
[OwlItemCache] -> ShowS
OwlItemCache -> String
(Int -> OwlItemCache -> ShowS)
-> (OwlItemCache -> String)
-> ([OwlItemCache] -> ShowS)
-> Show OwlItemCache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OwlItemCache -> ShowS
showsPrec :: Int -> OwlItemCache -> ShowS
$cshow :: OwlItemCache -> String
show :: OwlItemCache -> String
$cshowList :: [OwlItemCache] -> ShowS
showList :: [OwlItemCache] -> ShowS
Show)

owlItemCache_preRender :: OwlItemCache -> Maybe PreRender
owlItemCache_preRender :: OwlItemCache -> Maybe PreRender
owlItemCache_preRender = \case
  OwlItemCache_Line LineAnchorsForRender
_ PreRender
x -> PreRender -> Maybe PreRender
forall a. a -> Maybe a
Just PreRender
x
  OwlItemCache_Generic PreRender
x -> PreRender -> Maybe PreRender
forall a. a -> Maybe a
Just PreRender
x

newtype RenderCache = RenderCache {
    -- map for REltId to cache for each owl
    RenderCache -> REltIdMap OwlItemCache
unRenderCache :: REltIdMap OwlItemCache
  } deriving (Int -> RenderCache -> ShowS
[RenderCache] -> ShowS
RenderCache -> String
(Int -> RenderCache -> ShowS)
-> (RenderCache -> String)
-> ([RenderCache] -> ShowS)
-> Show RenderCache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RenderCache -> ShowS
showsPrec :: Int -> RenderCache -> ShowS
$cshow :: RenderCache -> String
show :: RenderCache -> String
$cshowList :: [RenderCache] -> ShowS
showList :: [RenderCache] -> ShowS
Show)

emptyRenderCache :: RenderCache
emptyRenderCache :: RenderCache
emptyRenderCache = REltIdMap OwlItemCache -> RenderCache
RenderCache REltIdMap OwlItemCache
forall a. IntMap a
IM.empty

renderCache_clearAtKeys :: RenderCache -> [REltId] -> RenderCache
renderCache_clearAtKeys :: RenderCache -> [Int] -> RenderCache
renderCache_clearAtKeys RenderCache
rcache [Int]
rids = REltIdMap OwlItemCache -> RenderCache
RenderCache (REltIdMap OwlItemCache -> RenderCache)
-> REltIdMap OwlItemCache -> RenderCache
forall a b. (a -> b) -> a -> b
$ (Int -> REltIdMap OwlItemCache -> REltIdMap OwlItemCache)
-> REltIdMap OwlItemCache -> [Int] -> REltIdMap OwlItemCache
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> REltIdMap OwlItemCache -> REltIdMap OwlItemCache
forall a. Int -> IntMap a -> IntMap a
IM.delete (RenderCache -> REltIdMap OwlItemCache
unRenderCache RenderCache
rcache) [Int]
rids

renderCache_lookup :: RenderCache -> REltId -> Maybe OwlItemCache
renderCache_lookup :: RenderCache -> Int -> Maybe OwlItemCache
renderCache_lookup RenderCache
rcache Int
rid = Int -> REltIdMap OwlItemCache -> Maybe OwlItemCache
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
rid (RenderCache -> REltIdMap OwlItemCache
unRenderCache RenderCache
rcache)


-- UNTESTED
makePreRender :: forall a. (HasOwlTree a) => a -> SEltDrawer -> PreRender
makePreRender :: forall a. HasOwlTree a => a -> SEltDrawer -> PreRender
makePreRender a
ot SEltDrawer {Int
SEltDrawerBoxFn
SEltDrawerRenderFn
_sEltDrawer_box :: SEltDrawerBoxFn
_sEltDrawer_renderFn :: SEltDrawerRenderFn
_sEltDrawer_maxCharWidth :: Int
_sEltDrawer_box :: SEltDrawer -> SEltDrawerBoxFn
_sEltDrawer_renderFn :: SEltDrawer -> SEltDrawerRenderFn
_sEltDrawer_maxCharWidth :: SEltDrawer -> Int
..} = PreRender
r where
  
  lbox' :: LBox
lbox' = a -> LBox
SEltDrawerBoxFn
_sEltDrawer_box a
ot 
  lbox :: LBox
lbox@(LBox XY
_ (V2 Int
w Int
_)) = LBox -> (Int, Int, Int, Int) -> LBox
lBox_expand LBox
lbox' (Int
0, Int
_sEltDrawer_maxCharWidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Int
0, Int
0)
  area :: Int
area = LBox -> Int
lBox_area LBox
lbox

  -- the (Int8, Int8, PChar) is (distance from prev wide pchar, width of prev wide pchar, wide pchar)
  -- width of prev wide pchar could be determined from wide pchar of course but may as well cache it
  unfoldrfn :: (Int, Maybe (Int8, Int8, PChar)) -> Maybe (MWidePChar, (Int, Maybe (Int8, Int8, PChar)))
  unfoldrfn :: (Int, Maybe (Int8, Int8, Char))
-> Maybe (MWidePChar, (Int, Maybe (Int8, Int8, Char)))
unfoldrfn (Int
i, Maybe (Int8, Int8, Char)
mprevwidechar) = Maybe (MWidePChar, (Int, Maybe (Int8, Int8, Char)))
r2 where
    pt :: XY
pt = LBox -> Int -> XY
toPoint LBox
lbox Int
i
    mchar :: Maybe Char
mchar = a -> XY -> Maybe Char
SEltDrawerRenderFn
_sEltDrawer_renderFn a
ot XY
pt
    mcharwithwidth :: Maybe (Char, Int8)
mcharwithwidth = (Char -> (Char, Int8)) -> Maybe Char -> Maybe (Char, Int8)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
pch -> (Char
pch, Char -> Int8
getPCharWidth Char
pch)) Maybe Char
mchar
    eol :: Bool
eol = (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

    moutputchar :: MWidePChar
moutputchar = case Maybe (Int8, Int8, Char)
mprevwidechar of
      Maybe (Int8, Int8, Char)
Nothing        -> case Maybe Char
mchar of  
        Just Char
pch -> (Int8
0, Char
pch)
        Maybe Char
Nothing -> MWidePChar
emptyMWidePChar 
      Just (Int8
a,Int8
_,Char
pch) -> (Int8
a, Char
pch)

    mnextwidechar :: Maybe (Int8, Int8, Char)
mnextwidechar = if Bool
eol 
      then Maybe (Int8, Int8, Char)
forall a. Maybe a
Nothing 
      else case Maybe (Int8, Int8, Char)
mprevwidechar of 
        Maybe (Int8, Int8, Char)
Nothing -> case Maybe (Char, Int8)
mcharwithwidth of 
          Maybe (Char, Int8)
Nothing -> Maybe (Int8, Int8, Char)
forall a. Maybe a
Nothing
          Just (Char
pch, Int8
width) -> if Int8
width Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
> Int8
1
            then (Int8, Int8, Char) -> Maybe (Int8, Int8, Char)
forall a. a -> Maybe a
Just (Int8
1,Int8
width,Char
pch)
            else Maybe (Int8, Int8, Char)
forall a. Maybe a
Nothing
        Just (Int8
a,Int8
b,Char
_) | Int8
a Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
bInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
-Int8
1 -> Maybe (Int8, Int8, Char)
forall a. Maybe a
Nothing
        Just (Int8
a,Int8
b,Char
pch) -> (Int8, Int8, Char) -> Maybe (Int8, Int8, Char)
forall a. a -> Maybe a
Just (Int8
aInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+Int8
1, Int8
b, Char
pch)

    r2 :: Maybe (MWidePChar, (Int, Maybe (Int8, Int8, Char)))
r2 = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
area 
      then Maybe (MWidePChar, (Int, Maybe (Int8, Int8, Char)))
forall a. Maybe a
Nothing
      else (MWidePChar, (Int, Maybe (Int8, Int8, Char)))
-> Maybe (MWidePChar, (Int, Maybe (Int8, Int8, Char)))
forall a. a -> Maybe a
Just (MWidePChar
moutputchar, (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Maybe (Int8, Int8, Char)
mnextwidechar))

  r :: PreRender
r = Vector MWidePChar -> LBox -> PreRender
PreRender (((Int, Maybe (Int8, Int8, Char))
 -> Maybe (MWidePChar, (Int, Maybe (Int8, Int8, Char))))
-> (Int, Maybe (Int8, Int8, Char)) -> Vector MWidePChar
forall a b. Unbox a => (b -> Maybe (a, b)) -> b -> Vector a
V.unfoldr (Int, Maybe (Int8, Int8, Char))
-> Maybe (MWidePChar, (Int, Maybe (Int8, Int8, Char)))
unfoldrfn (Int
0,Maybe (Int8, Int8, Char)
forall a. Maybe a
Nothing)) LBox
lbox