{-# 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)
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)
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)
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
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
(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
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
data OwlItemCache =
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 {
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)
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
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