-------------------------------------------------------------------------------- {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Patat.Presentation.Internal ( Breadcrumbs , Presentation (..) , PresentationSettings (..) , defaultPresentationSettings , MarginSettings (..) , Margins (..) , margins , ExtensionList (..) , defaultExtensionList , ImageSettings (..) , EvalSettingsMap , EvalSettings (..) , Slide (..) , SlideContent (..) , Instruction.Fragment (..) , Index , getSlide , numFragments , ActiveFragment (..) , activeFragment , activeSpeakerNotes , getSettings , activeSettings , Size , getPresentationSize ) where -------------------------------------------------------------------------------- import qualified Data.Aeson.Extended as A import Data.Maybe (fromMaybe) import Data.Sequence.Extended (Seq) import qualified Data.Sequence.Extended as Seq import Patat.EncodingFallback (EncodingFallback) import qualified Patat.Presentation.Comments as Comments import qualified Patat.Presentation.Instruction as Instruction import Patat.Presentation.Settings import Patat.Size import Patat.Transition (TransitionGen) import Prelude import qualified Skylighting as Skylighting import qualified Text.Pandoc as Pandoc -------------------------------------------------------------------------------- type Breadcrumbs = [(Int, [Pandoc.Inline])] -------------------------------------------------------------------------------- data Presentation = Presentation { pFilePath :: !FilePath , pEncodingFallback :: !EncodingFallback , pTitle :: ![Pandoc.Inline] , pAuthor :: ![Pandoc.Inline] , pSettings :: !PresentationSettings , pSlides :: !(Seq Slide) , pBreadcrumbs :: !(Seq Breadcrumbs) -- One for each slide. , pSlideSettings :: !(Seq PresentationSettings) -- One for each slide. , pTransitionGens :: !(Seq (Maybe TransitionGen)) -- One for each slide. , pActiveFragment :: !Index , pSyntaxMap :: !Skylighting.SyntaxMap } -------------------------------------------------------------------------------- data Margins = Margins { mTop :: AutoOr Int , mLeft :: AutoOr Int , mRight :: AutoOr Int } deriving (Show) -------------------------------------------------------------------------------- margins :: PresentationSettings -> Margins margins ps = Margins { mLeft = get 0 msLeft , mRight = get 0 msRight , mTop = get 1 msTop } where get def f = case psMargins ps >>= f of Just Auto -> Auto Nothing -> NotAuto def Just (NotAuto fn) -> NotAuto $ A.unFlexibleNum fn -------------------------------------------------------------------------------- data Slide = Slide { slideComment :: !Comments.Comment , slideContent :: !SlideContent } deriving (Show) -------------------------------------------------------------------------------- data SlideContent = ContentSlide (Instruction.Instructions Pandoc.Block) | TitleSlide Int [Pandoc.Inline] deriving (Show) -------------------------------------------------------------------------------- -- | Active slide, active fragment. type Index = (Int, Int) -------------------------------------------------------------------------------- getSlide :: Int -> Presentation -> Maybe Slide getSlide sidx = (`Seq.safeIndex` sidx) . pSlides -------------------------------------------------------------------------------- numFragments :: Slide -> Int numFragments slide = case slideContent slide of ContentSlide instrs -> Instruction.numFragments instrs TitleSlide _ _ -> 1 -------------------------------------------------------------------------------- data ActiveFragment = ActiveContent Instruction.Fragment | ActiveTitle Pandoc.Block deriving (Show) -------------------------------------------------------------------------------- activeFragment :: Presentation -> Maybe ActiveFragment activeFragment presentation = do let (sidx, fidx) = pActiveFragment presentation slide <- getSlide sidx presentation pure $ case slideContent slide of TitleSlide lvl is -> ActiveTitle $ Pandoc.Header lvl Pandoc.nullAttr is ContentSlide instrs -> ActiveContent $ Instruction.renderFragment fidx instrs -------------------------------------------------------------------------------- activeSpeakerNotes :: Presentation -> Comments.SpeakerNotes activeSpeakerNotes presentation = fromMaybe mempty $ do let (sidx, _) = pActiveFragment presentation slide <- getSlide sidx presentation pure . Comments.cSpeakerNotes $ slideComment slide -------------------------------------------------------------------------------- getSettings :: Int -> Presentation -> PresentationSettings getSettings sidx pres = fromMaybe mempty (Seq.safeIndex (pSlideSettings pres) sidx) <> pSettings pres -------------------------------------------------------------------------------- activeSettings :: Presentation -> PresentationSettings activeSettings pres = let (sidx, _) = pActiveFragment pres in getSettings sidx pres -------------------------------------------------------------------------------- getPresentationSize :: Presentation -> IO Size getPresentationSize pres = do term <- getTerminalSize let rows = fromMaybe (sRows term) $ A.unFlexibleNum <$> psRows settings cols = fromMaybe (sCols term) $ A.unFlexibleNum <$> psColumns settings pure $ Size {sRows = rows, sCols = cols} where settings = activeSettings pres