content: {-# LANGUAGE GADTs #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE RecordWildCards #-}
  
  module Graphics.Hoodle.Render.Type.Renderer where
  
  import Control.Concurrent.STM
    ( STM,
      TMVar,
      TVar,
      readTVar,
      readTVarIO,
      writeTVar,
    )
  import Control.Monad.IO.Class (MonadIO (liftIO))
  import Control.Monad.Trans.Reader (ReaderT)
  import qualified Data.ByteString.Char8 as B
  import qualified Data.HashMap.Strict as HM
  import Data.Hashable (Hashable (..))
  import Data.Hoodle.Simple (Dimension (..))
  import Data.Sequence (Seq, (|>))
  import qualified Data.Sequence as Seq (filter)
  import Data.UUID (UUID)
  import Data.UUID.V4 (nextRandom)
  import Graphics.Hoodle.Render.Type.Item (RItem)
  import qualified Graphics.Rendering.Cairo as Cairo
  
  -- import qualified Graphics.UI.Gtk.Poppler.Document as Poppler
  
  newtype PDFCommandID = PDFCommandID UUID deriving (Show, Eq, Ord)
  
  data PDFCommand where
    GetDocFromFile :: B.ByteString -> TMVar (Maybe () {- Poppler.Document -}) -> PDFCommand
    GetDocFromDataURI :: B.ByteString -> TMVar (Maybe () {- Poppler.Document -}) -> PDFCommand
    GetPageFromDoc :: () {- Poppler.Document -} -> !Int -> TMVar (Maybe () {- Poppler.Page -}) -> PDFCommand
    GetNPages {- !Poppler.Document -} :: () -> TMVar Int -> PDFCommand
    RenderPageScaled :: SurfaceID -> () {- Poppler.Page -} -> Dimension -> Dimension -> PDFCommand
  
  instance Show PDFCommand where
    show _ = "PDFCommand"
  
  newtype GenCommandID = GenCommandID UUID deriving (Show, Eq, Ord)
  
  data GenCommand where
    BkgSmplScaled :: SurfaceID -> B.ByteString -> B.ByteString -> Dimension -> Dimension -> GenCommand
    LayerInit :: SurfaceID -> [RItem] -> GenCommand
    LayerRedraw :: SurfaceID -> [RItem] -> GenCommand
    LayerScaled :: SurfaceID -> [RItem] -> Dimension -> Dimension -> GenCommand
  
  instance Show GenCommand where
    show (BkgSmplScaled sfcid _ _ _ _) = "BkgSmplScaled:" ++ show sfcid
    show (LayerInit sfcid _) = "LayerInit:" ++ show sfcid
    show (LayerRedraw sfcid _) = "LayerRedraw:" ++ show sfcid
    show (LayerScaled sfcid _ _ _) = "LayerScaled:" ++ show sfcid
  
  newtype SurfaceID = SurfaceID UUID deriving (Show, Eq, Ord, Hashable)
  
  -- |
  type CanvasId = Int
  
  -- | hashmap: key = UUID, value = (original size, view size, surface)
  type RenderCache = HM.HashMap SurfaceID (Double, Cairo.Surface)
  
  -- |
  data RendererEvent
    = SurfaceUpdate (SurfaceID, (Double, Cairo.Surface))
    | FinishCommandFor SurfaceID
  
  type PDFCommandQueue = TVar (Seq (PDFCommandID, PDFCommand))
  
  type GenCommandQueue = TVar (Seq (GenCommandID, GenCommand))
  
  data RendererState = RendererState
    { rendererHandler :: RendererEvent -> IO (),
      rendererPDFCmdQ :: PDFCommandQueue,
      rendererGenCmdQ :: GenCommandQueue,
      rendererCache :: TVar RenderCache
    }
  
  getRenderCache :: RendererState -> IO RenderCache
  getRenderCache RendererState {..} = readTVarIO rendererCache
  
  type Renderer = ReaderT RendererState IO
  
  issuePDFCommandID :: (Functor m, MonadIO m) => m PDFCommandID
  issuePDFCommandID = PDFCommandID <$> liftIO nextRandom
  
  issueGenCommandID :: (Functor m, MonadIO m) => m GenCommandID
  issueGenCommandID = GenCommandID <$> liftIO nextRandom
  
  issueSurfaceID :: (Functor m, MonadIO m) => m SurfaceID
  issueSurfaceID = SurfaceID <$> liftIO nextRandom
  
  sendPDFCommand ::
    PDFCommandQueue ->
    PDFCommandID ->
    PDFCommand ->
    STM ()
  sendPDFCommand queuevar cmdid cmd = do
    queue <- readTVar queuevar
    let queue' = Seq.filter (not . isRemoved (cmdid, cmd)) queue
        nqueue = queue' |> (cmdid, cmd)
    writeTVar queuevar nqueue
  
  isRemoved :: (PDFCommandID, PDFCommand) -> (PDFCommandID, PDFCommand) -> Bool
  isRemoved (cmdid, ncmd) (ocmdid, ocmd)
    | cmdid == ocmdid = True
    | otherwise = case ncmd of
      RenderPageScaled nsfcid _ _ _ ->
        case ocmd of
          RenderPageScaled osfcid _ _ _ -> nsfcid == osfcid
          _ -> False
      _ -> False
  
  sendGenCommand ::
    GenCommandQueue ->
    GenCommandID ->
    GenCommand ->
    STM ()
  sendGenCommand queuevar cmdid cmd = do
    queue <- readTVar queuevar
    let queue' = Seq.filter (not . isRemovedGen (cmdid, cmd)) queue
        nqueue = queue' |> (cmdid, cmd)
    writeTVar queuevar nqueue
  
  surfaceID :: GenCommand -> SurfaceID
  surfaceID (BkgSmplScaled sfcid _ _ _ _) = sfcid
  surfaceID (LayerInit sfcid _) = sfcid
  surfaceID (LayerRedraw sfcid _) = sfcid
  surfaceID (LayerScaled sfcid _ _ _) = sfcid
  
  isRemovedGen :: (GenCommandID, GenCommand) -> (GenCommandID, GenCommand) -> Bool
  isRemovedGen (cmdid, ncmd) (ocmdid, ocmd)
    | cmdid == ocmdid = True
    | otherwise = case ncmd of
      BkgSmplScaled nsfcid _ _ _ _ -> surfaceID ocmd == nsfcid
      LayerScaled nsfcid _ _ _ -> surfaceID ocmd == nsfcid
      _ -> False
  