{-# 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.Vector.Unboxed as V
import Control.Exception (assert)
toPoint :: LBox -> Int -> XY
toPoint :: LBox -> Int -> XY
toPoint (LBox (V2 Int
x Int
y) (V2 Int
w Int
_)) Int
i = forall a. a -> a -> V2 a
V2 (Int
i forall a. Integral a => a -> a -> a
`mod` Int
w forall a. Num a => a -> a -> a
+ Int
x) (Int
i forall a. Integral a => a -> a -> a
`div` Int
w forall a. Num a => a -> a -> a
+ Int
y)
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
pyforall a. Num a => a -> a -> a
-Int
y)forall a. Num a => a -> a -> a
*Int
wforall a. Num a => a -> a -> a
+(Int
pxforall a. Num a => a -> a -> a
-Int
x)
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 forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ LBox -> XY -> Int
toIndex LBox
lbx XY
xy
else forall a. Maybe a
Nothing
type MWidePChar = (Int8, PChar)
emptyMWidePChar :: MWidePChar
emptyMWidePChar :: MWidePChar
emptyMWidePChar = (-Int8
1, Char
' ')
data PreRender = PreRender (V.Vector (MWidePChar)) LBox deriving (Int -> PreRender -> ShowS
[PreRender] -> ShowS
PreRender -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreRender] -> ShowS
$cshowList :: [PreRender] -> ShowS
show :: PreRender -> String
$cshow :: PreRender -> String
showsPrec :: Int -> PreRender -> ShowS
$cshowsPrec :: Int -> PreRender -> ShowS
Show)
emptyPreRender :: PreRender
emptyPreRender :: PreRender
emptyPreRender = Vector MWidePChar -> LBox -> PreRender
PreRender 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
r :: MWidePChar
r = if LBox -> XY -> Bool
does_lBox_contains_XY LBox
lbox XY
pos
then case Vector MWidePChar
v forall a. Unbox a => Vector a -> Int -> Maybe a
V.!? (LBox -> XY -> Int
toIndex LBox
lbox XY
pos) of
Maybe MWidePChar
Nothing -> forall a. HasCallStack => Bool -> a -> a
assert Bool
False MWidePChar
emptyMWidePChar
Just MWidePChar
x -> MWidePChar
x
else MWidePChar
emptyMWidePChar
data OwlItemCache =
OwlItemCache_Line LineAnchorsForRender PreRender
| OwlItemCache_Generic PreRender deriving (Int -> OwlItemCache -> ShowS
[OwlItemCache] -> ShowS
OwlItemCache -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OwlItemCache] -> ShowS
$cshowList :: [OwlItemCache] -> ShowS
show :: OwlItemCache -> String
$cshow :: OwlItemCache -> String
showsPrec :: Int -> OwlItemCache -> ShowS
$cshowsPrec :: Int -> OwlItemCache -> ShowS
Show)
owlItemCache_preRender :: OwlItemCache -> Maybe PreRender
owlItemCache_preRender :: OwlItemCache -> Maybe PreRender
owlItemCache_preRender = \case
OwlItemCache_Line LineAnchorsForRender
_ PreRender
x -> forall a. a -> Maybe a
Just PreRender
x
OwlItemCache_Generic PreRender
x -> forall a. a -> Maybe a
Just PreRender
x
newtype RenderCache = RenderCache {
RenderCache -> REltIdMap OwlItemCache
unRenderCache :: REltIdMap OwlItemCache
} deriving (Int -> RenderCache -> ShowS
[RenderCache] -> ShowS
RenderCache -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderCache] -> ShowS
$cshowList :: [RenderCache] -> ShowS
show :: RenderCache -> String
$cshow :: RenderCache -> String
showsPrec :: Int -> RenderCache -> ShowS
$cshowsPrec :: Int -> RenderCache -> ShowS
Show)
emptyRenderCache :: RenderCache
emptyRenderCache :: RenderCache
emptyRenderCache = REltIdMap OwlItemCache -> RenderCache
RenderCache 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 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 = forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
rid (RenderCache -> REltIdMap OwlItemCache
unRenderCache RenderCache
rcache)
makePreRender :: forall a. (HasOwlTree a) => a -> SEltDrawer -> PreRender
makePreRender :: forall a. HasOwlTree a => a -> SEltDrawer -> PreRender
makePreRender a
ot SEltDrawer {Int
SEltDrawerBoxFn
SEltDrawerRenderFn
_sEltDrawer_maxCharWidth :: SEltDrawer -> Int
_sEltDrawer_renderFn :: SEltDrawer -> SEltDrawerRenderFn
_sEltDrawer_box :: SEltDrawer -> SEltDrawerBoxFn
_sEltDrawer_maxCharWidth :: Int
_sEltDrawer_renderFn :: SEltDrawerRenderFn
_sEltDrawer_box :: SEltDrawerBoxFn
..} = PreRender
r where
lbox' :: LBox
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_maxCharWidthforall a. Num a => a -> a -> a
-Int
1, Int
0, Int
0)
area :: Int
area = LBox -> Int
lBox_area LBox
lbox
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 = SEltDrawerRenderFn
_sEltDrawer_renderFn a
ot XY
pt
mcharwithwidth :: Maybe (Char, Int8)
mcharwithwidth = 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
iforall a. Num a => a -> a -> a
+Int
1) forall a. Integral a => a -> a -> a
`mod` Int
w 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 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 -> forall a. Maybe a
Nothing
Just (Char
pch, Int8
width) -> if Int8
width forall a. Ord a => a -> a -> Bool
> Int8
1
then forall a. a -> Maybe a
Just (Int8
1,Int8
width,Char
pch)
else forall a. Maybe a
Nothing
Just (Int8
a,Int8
b,Char
_) | Int8
a forall a. Eq a => a -> a -> Bool
== Int8
bforall a. Num a => a -> a -> a
-Int8
1 -> forall a. Maybe a
Nothing
Just (Int8
a,Int8
b,Char
pch) -> forall a. a -> Maybe a
Just (Int8
aforall a. Num a => a -> a -> a
+Int8
1, Int8
b, Char
pch)
r2 :: Maybe (MWidePChar, (Int, Maybe (Int8, Int8, Char)))
r2 = if Int
i forall a. Eq a => a -> a -> Bool
== Int
area
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (MWidePChar
moutputchar, (Int
iforall a. Num a => a -> a -> a
+Int
1, Maybe (Int8, Int8, Char)
mnextwidechar))
r :: PreRender
r = Vector MWidePChar -> LBox -> PreRender
PreRender (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,forall a. Maybe a
Nothing)) LBox
lbox