packages feed

tinytools-0.1.0.0: src/Potato/Flow/Render.hs

{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Render (
  RenderCache(..)
  , RenderContext(..)
  , emptyRenderContext
  , emptyRenderCache
  , renderCache_clearAtKeys
  , renderCache_lookup
  , render -- TODO DELETE use render_new instead because it uses cache
  , render_new

  , RenderedCanvasRegion(..)
  , renderedCanvas_box
  , renderedCanvasRegion_nonEmptyCount
  , emptyRenderedCanvasRegion
  , printRenderedCanvasRegion
  , potatoRenderWithOwlTree
  , potatoRenderPFState
  , renderedCanvasToText
  , renderedCanvasRegionToText

  , renderWithBroadPhase
  , moveRenderedCanvasRegion
  , updateCanvas

  -- exposed for testing
  , moveRenderedCanvasRegionNoReRender
) where

import           Relude

import           Potato.Flow.RenderCache
import           Potato.Flow.BroadPhase
import           Potato.Flow.Math
import           Potato.Flow.SEltMethods
import           Potato.Flow.Methods.Types
import           Potato.Flow.SElts
import Potato.Flow.Types
import Potato.Flow.OwlState
import           Potato.Flow.OwlItem
import Potato.Flow.Owl
import           Potato.Flow.Controller.Types
import           Potato.Flow.Controller.OwlLayers
import           Potato.Flow.Methods.LineTypes


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

-- rather pointless abstraction but it's useful to have during refactors such that I don't ned to provide an explicit LayerMetaMap
class OwlRenderSet a where
  findSuperOwl :: a -> REltId -> Maybe (SuperOwl, Bool)
  sortForRendering :: a -> Seq.Seq SuperOwl -> Seq.Seq SuperOwl
  findSuperOwlForRendering :: a -> REltId -> Maybe SuperOwl
  findSuperOwlForRendering ors rid = case findSuperOwl ors rid of
    Nothing -> Nothing
    Just (sowl, b) -> if b then Nothing else Just sowl

instance OwlRenderSet OwlTree where
  findSuperOwl ot = fmap (,False) . owlTree_findSuperOwl ot
  sortForRendering a sowls = unSuperOwlParliament $ makeSortedSuperOwlParliament a sowls

instance OwlRenderSet (OwlTree, LayerMetaMap) where
  findSuperOwl (ot,lmm) rid = r where
    hidden = layerMetaMap_isInheritHidden ot rid lmm
    r = fmap (,hidden) $ owlTree_findSuperOwl ot rid
  sortForRendering (ot,_) sowls = sortForRendering ot sowls

-- RenderContext is a helper container type that provides both read and write data for various render operations
data RenderContext = RenderContext {
  _renderContext_cache :: RenderCache -- r/w
  , _renderContext_owlTree :: OwlTree -- r
  , _renderContext_layerMetaMap :: LayerMetaMap -- r
  , _renderContext_broadPhase :: BroadPhaseState -- r
  , _renderContext_renderedCanvasRegion :: RenderedCanvasRegion -- r/w
}

emptyRenderContext :: LBox -> RenderContext
emptyRenderContext lbox = RenderContext {
    _renderContext_cache = emptyRenderCache
    , _renderContext_owlTree = emptyOwlTree
    , _renderContext_layerMetaMap = IM.empty
    , _renderContext_broadPhase = emptyBroadPhaseState
    , _renderContext_renderedCanvasRegion = emptyRenderedCanvasRegion lbox
  }


instance HasOwlTree RenderContext where
  hasOwlTree_owlTree = hasOwlTree_owlTree . _renderContext_owlTree

instance OwlRenderSet RenderContext where
  findSuperOwl RenderContext {..} rid = findSuperOwl (_renderContext_owlTree, _renderContext_layerMetaMap) rid
  sortForRendering RenderContext {..} sowls = sortForRendering (_renderContext_owlTree, _renderContext_layerMetaMap) sowls



emptyChar :: PChar
emptyChar = ' '


-- TODO for selection rendering you want to make it V.Vector (Maybe PChar) or maybe you can just use a map?
{-
class IsRenderedCanvasRegion rc where
  isRenderedCanvasRegion_area :: LBox
  isRenderedCanvasRegion_generateMaybe :: (Int, Int) -> ((Int, Int) -> Maybe PChar) -> rc
-}

-- A rendered region in Canvas space
data RenderedCanvasRegion = RenderedCanvasRegion {
  _renderedCanvasRegion_box        :: LBox
  , _renderedCanvasRegion_contents :: V.Vector MWidePChar -- ^ row major
} deriving (Eq, Show)

renderedCanvas_box :: RenderedCanvasRegion -> LBox
renderedCanvas_box = _renderedCanvasRegion_box

emptyRenderedCanvasRegion :: LBox -> RenderedCanvasRegion
emptyRenderedCanvasRegion lb@(LBox _ (V2 w h)) = RenderedCanvasRegion {
    _renderedCanvasRegion_box = lb
    , _renderedCanvasRegion_contents = V.replicate (w*h) emptyMWidePChar
  }

-- empty spaces due to wide chars to the left are not counted
renderedCanvasRegion_nonEmptyCount :: RenderedCanvasRegion -> Int
renderedCanvasRegion_nonEmptyCount = V.length . V.filter (\x -> x /= emptyMWidePChar) . _renderedCanvasRegion_contents

-- | brute force renders a RenderedCanvasRegion (ignores broadphase)
potatoRenderWithOwlTree :: OwlTree -> [OwlSubItem] -> RenderedCanvasRegion -> RenderedCanvasRegion
potatoRenderWithOwlTree ot osubitems prevrcr = r where
  drawerswithcache = fmap (\osubitem -> (getDrawerWithCache osubitem Nothing, Nothing)) osubitems 
  llbx = _renderedCanvasRegion_box prevrcr
  r = render_withCache ot llbx drawerswithcache prevrcr

potatoRenderPFState :: OwlPFState -> RenderedCanvasRegion
potatoRenderPFState OwlPFState {..} = potatoRenderWithOwlTree _owlPFState_owlTree (fmap _owlItem_subItem . fmap snd . toList . _owlTree_mapping $ _owlPFState_owlTree) (emptyRenderedCanvasRegion (_sCanvas_box _owlPFState_canvas))


render_withCache :: (HasOwlTree a) => a -> LBox -> [(SEltDrawer, Maybe OwlItemCache)] -> RenderedCanvasRegion -> RenderedCanvasRegion
render_withCache ot llbx drawerswithcache prevrcr = r where

  genfn i = newc' where
    -- construct parent point and index
    pt = toPoint llbx i
    pindex = toIndex (_renderedCanvasRegion_box prevrcr) pt

    -- go through drawers in reverse order until you find a match
    --mdrawn = join . find isJust $ (fmap (\d -> _sEltDrawer_renderFn d _renderContext_owlTree pt) drawers)
    -- go through caches (they should have all been updated in the previous step) until you find a match
    drawfn (drawer, mcache) = case mcache of
      Nothing -> drawnocache
      --Just _ -> drawnocache
      Just cache -> case owlItemCache_preRender cache of
        Nothing -> drawnocache
        Just pr -> case preRender_lookup pr pt of
          (-1, _) -> Nothing
          x       -> Just x
      where
        drawnocache = case _sEltDrawer_renderFn drawer ot pt of
          Nothing -> Nothing
          Just x  -> Just (0, x)
    mdrawn = join . find isJust $ fmap drawfn drawerswithcache

    -- render what we found or empty otherwise
    newc' = case mdrawn of
      Just c  -> (pindex, c)
      Nothing -> (pindex, emptyMWidePChar)

  -- go through each point in target LBox and render it
  newc = V.generate (lBox_area llbx) genfn
  r = prevrcr {
      _renderedCanvasRegion_contents = V.update (_renderedCanvasRegion_contents prevrcr) newc
    }


-- TODO DELETE use render_new instead
-- | renders just a portion of the RenderedCanvasRegion
-- caller is expected to provide all SElts that intersect the rendered LBox (broadphase is ignored)
-- SElts are rendered in ORDER
render :: LBox -> [OwlSubItem] -> RenderContext -> RenderContext
render llbx osubitems rctx@RenderContext {..} = r where
  drawerswithcache = fmap (\osubitem -> (getDrawerWithCache osubitem Nothing, Nothing)) osubitems 
  prevrcr = _renderContext_renderedCanvasRegion
  r = rctx {
      _renderContext_renderedCanvasRegion = render_withCache _renderContext_owlTree llbx drawerswithcache prevrcr
    }

mapREltIdToCaches :: OwlTree -> [REltId] -> RenderCache -> (RenderCache, [(OwlSubItem, Maybe OwlItemCache)])
mapREltIdToCaches ot rids rcache = r where

  mapaccumlfn cacheacc rid = r where
    -- see if it was in the previous cache
    mprevcache = IM.lookup rid (unRenderCache rcache)
    sowl = owlTree_mustFindSuperOwl ot rid
    OwlItem _ osubitem = _superOwl_elt sowl
    mupdatedcache = updateOwlSubItemCache ot osubitem
    r = case mprevcache of
      Just c -> (cacheacc, (osubitem, Just c))
      Nothing -> case mupdatedcache of
        Just c  -> (IM.insert rid c cacheacc, (osubitem, Just c))
        Nothing -> (cacheacc, (osubitem, Nothing))
  (newcache, owlswithcache) = mapAccumL mapaccumlfn (unRenderCache rcache) rids
  r = (RenderCache newcache, owlswithcache)



-- | renders just a portion of the RenderedCanvasRegion
-- updates cache as appropriate
-- caller is expected to provide all REltIds that intersect the rendered LBox (broadphase is ignored)
-- REltIds are rendered in ORDER
render_new :: LBox -> [REltId] -> RenderContext -> RenderContext
render_new llbx rids rctx@RenderContext {..} = rctxout where
  (newcache, owlswithcache) = mapREltIdToCaches _renderContext_owlTree rids _renderContext_cache
  drawerswithcache = map (\(x, c)-> (getDrawerWithCache x c, c)) owlswithcache 
  rctxout = rctx {
      _renderContext_cache = newcache
      , _renderContext_renderedCanvasRegion = render_withCache _renderContext_owlTree llbx drawerswithcache _renderContext_renderedCanvasRegion
    }


renderedCanvasToText :: RenderedCanvasRegion -> Text
renderedCanvasToText rcr = renderedCanvasRegionToText (_renderedCanvasRegion_box rcr) rcr


-- TODO this does not handle wide chars at all fack
-- | assumes region LBox is strictly contained in _renderedCanvasRegion_box
renderedCanvasRegionToText :: LBox -> RenderedCanvasRegion -> Text
renderedCanvasRegionToText lbx RenderedCanvasRegion {..} = if not validBoxes 
  then error ("render region outside canvas:\n" <> show lbx <> "\n" <> show _renderedCanvasRegion_box)
  else r 
  where
    validBoxes = intersect_lBox_include_zero_area lbx _renderedCanvasRegion_box == Just lbx
    -- TODO preloop and include widechars

    l = lBox_area lbx
    (LBox _ (V2 lw _)) = lbx
    unfoldfn (i, eol, waseol) = if i == l
      then Nothing
      else if eol
        -- use -2 to indicate eol
        then Just $ (eolchar, (i, False, newwaseol))
        else Just $ (regchar, (i+1, neweol, newwaseol))
        where
          neweol = (i+1) `mod` lw == 0
          -- maintain waseol status if there is offset
          newwaseol = eol || (waseol && ofs > 0)
          (ofs, pch) = _renderedCanvasRegion_contents V.! pindex
          eolchar = Just '\n'
          regchar = if waseol && ofs > 0
            -- TODO is this what we want? Will this overwrite the previous wide char? Also this should never happen as broadphase should have included the widechar at bol
            -- if we were at eol and there is offset then use ' ' padding character
            then Just ' '
            else if ofs > 0
              -- if there is offset, skip the character
              then Nothing
              else Just pch
          pt = toPoint lbx i
          pindex = toIndex _renderedCanvasRegion_box pt
    
    -- TODO use something more efficient than a string
    r' = unfoldr unfoldfn (0, False, True)
    r = T.pack $ mapMaybe id r' 
  

printRenderedCanvasRegion :: RenderedCanvasRegion -> IO ()
printRenderedCanvasRegion rc@RenderedCanvasRegion {..} = T.putStrLn $ renderedCanvasRegionToText _renderedCanvasRegion_box rc

renderWithBroadPhase :: LBox -> RenderContext -> RenderContext
renderWithBroadPhase  lbx rctx@RenderContext {..} = r where
  bpt = (_broadPhaseState_bPTree _renderContext_broadPhase)
  rids = broadPhase_cull lbx bpt

  -- TODO I THINK THIS IS INCORRECT DELETE, specifically, broadPhase_cull will give hidden elements that we can't find with findSuperOwlForRendering
  {-sowls' = flip fmap rids $ \rid -> case findSuperOwlForRendering ot rid of
      Nothing -> error "this should never happen, because broadPhase_cull should only give existing seltls"
      Just sowl -> sowl-}

  sowls' = catMaybes $ fmap (\rid -> findSuperOwlForRendering _renderContext_owlTree rid) rids

  sowls = sortForRendering _renderContext_owlTree $ Seq.fromList sowls'
  sortedrids = fmap _superOwl_id $ toList sowls

  r = render_new lbx sortedrids rctx

moveRenderedCanvasRegionNoReRender :: LBox -> RenderedCanvasRegion -> RenderedCanvasRegion
moveRenderedCanvasRegionNoReRender lbx RenderedCanvasRegion {..} = assert (area >= 0) outrcr where
  -- unnecessary to init with empty vector as moveRenderedCanvasRegion will re-render those areas
  -- but it's still nice to do and makes testing easier
  area = lBox_area lbx
  emptyv = V.replicate area emptyMWidePChar
  newv = case intersect_lBox lbx _renderedCanvasRegion_box of
    Just intersectlbx -> copiedv where
      (l,r,t,b) = lBox_to_axis intersectlbx
      -- [(newIndex, oldIndex)]
      indices' = [toIndexSafe _renderedCanvasRegion_box (V2 x y) >>= return . (toIndex lbx (V2 x y),) | x <- [l..(r-1)], y <- [t..(b-1)]]
      indices = catMaybes indices'
      indexedValues = fmap (\(idx, oldidx) -> (idx, _renderedCanvasRegion_contents V.! oldidx)) indices
      copiedv = (V.//) emptyv indexedValues
    Nothing -> emptyv

  outrcr = RenderedCanvasRegion {
      _renderedCanvasRegion_box = lbx
      , _renderedCanvasRegion_contents = newv
    }

moveRenderedCanvasRegion ::  LBox -> RenderContext -> RenderContext
moveRenderedCanvasRegion lbx rctx@RenderContext {..} = r where
  prevrc = _renderContext_renderedCanvasRegion
  rctx1 = rctx {
      _renderContext_renderedCanvasRegion = moveRenderedCanvasRegionNoReRender lbx prevrc
    }
  r = foldr renderWithBroadPhase rctx1 (substract_lBox lbx (_renderedCanvasRegion_box prevrc))

updateCanvas :: SuperOwlChanges -> NeedsUpdateSet -> RenderContext -> RenderContext
updateCanvas cslmap needsupdateaabbs rctx@RenderContext {..} = case needsupdateaabbs of
  [] -> rctx
  -- TODO create disjoint union of all boxes and render than one at a time instead union_lBoxing them all
  --aoeu@(b:bs) -> trace "UPDATE CANVAS" $ traceShow aoeu $ case intersect_lBox (renderedCanvas_box _renderContext_renderedCanvasRegion) (foldl' union_lBox b bs) of
  (b:bs) -> case intersect_lBox (renderedCanvas_box _renderContext_renderedCanvasRegion) (foldl' union_lBox b bs) of
    Nothing -> rctx
    Just aabb -> r where
      rids = broadPhase_cull aabb (_broadPhaseState_bPTree _renderContext_broadPhase)

      msowls = flip fmap rids $ \rid -> case IM.lookup rid cslmap of
        Nothing -> case findSuperOwl _renderContext_owlTree rid of
          Nothing -> error "this should never happen, because broadPhase_cull should only give existing seltls"
          -- changes could indicate hidden, if that's the case, give a dummy object to render
          Just (sowl, hidden) -> if hidden then Nothing else Just sowl
        Just msowl -> case msowl of
          Nothing -> error "this should never happen, because deleted seltl would have been culled in broadPhase_cull"
          Just sowl -> Just sowl
      sowls = sortForRendering _renderContext_owlTree $ Seq.fromList (catMaybes msowls)
      sortedrids = fmap _superOwl_id $ toList sowls
      r = render_new aabb sortedrids rctx