summaryrefslogtreecommitdiff
path: root/src/Patat/Presentation/Internal.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Patat/Presentation/Internal.hs')
-rw-r--r--src/Patat/Presentation/Internal.hs78
1 files changed, 57 insertions, 21 deletions
diff --git a/src/Patat/Presentation/Internal.hs b/src/Patat/Presentation/Internal.hs
index f11c46b..3554923 100644
--- a/src/Patat/Presentation/Internal.hs
+++ b/src/Patat/Presentation/Internal.hs
@@ -6,6 +6,11 @@ module Patat.Presentation.Internal
, PresentationSettings (..)
, defaultPresentationSettings
, Slide (..)
+ , Fragment (..)
+ , Index
+
+ , getSlide
+ , getActiveFragment
) where
@@ -13,7 +18,8 @@ module Patat.Presentation.Internal
import Control.Monad (mplus)
import qualified Data.Aeson.Extended as A
import qualified Data.Aeson.TH.Extended as A
-import Data.Monoid (Monoid (..))
+import Data.Maybe (listToMaybe)
+import Data.Monoid (Monoid (..), (<>))
import qualified Patat.Theme as Theme
import qualified Text.Pandoc as Pandoc
import Prelude
@@ -21,12 +27,12 @@ import Prelude
--------------------------------------------------------------------------------
data Presentation = Presentation
- { pFilePath :: !FilePath
- , pTitle :: ![Pandoc.Inline]
- , pAuthor :: ![Pandoc.Inline]
- , pSettings :: !PresentationSettings
- , pSlides :: [Slide]
- , pActiveSlide :: !Int
+ { pFilePath :: !FilePath
+ , pTitle :: ![Pandoc.Inline]
+ , pAuthor :: ![Pandoc.Inline]
+ , pSettings :: !PresentationSettings
+ , pSlides :: [Slide]
+ , pActiveFragment :: !Index
} deriving (Show)
@@ -34,38 +40,68 @@ data Presentation = Presentation
-- | These are patat-specific settings. That is where they differ from more
-- general metadata (author, title...)
data PresentationSettings = PresentationSettings
- { psRows :: !(Maybe (A.FlexibleNum Int))
- , psColumns :: !(Maybe (A.FlexibleNum Int))
- , psWrap :: !(Maybe Bool)
- , psTheme :: !(Maybe Theme.Theme)
+ { psRows :: !(Maybe (A.FlexibleNum Int))
+ , psColumns :: !(Maybe (A.FlexibleNum Int))
+ , psWrap :: !(Maybe Bool)
+ , psTheme :: !(Maybe Theme.Theme)
+ , psIncrementalLists :: !(Maybe Bool)
+ , psAutoAdvanceDelay :: !(Maybe (A.FlexibleNum Int))
} deriving (Show)
--------------------------------------------------------------------------------
instance Monoid PresentationSettings where
- mempty = PresentationSettings Nothing Nothing Nothing Nothing
+ mempty = PresentationSettings
+ Nothing Nothing Nothing Nothing Nothing Nothing
mappend l r = PresentationSettings
- { psRows = psRows l `mplus` psRows r
- , psColumns = psColumns l `mplus` psColumns r
- , psWrap = psWrap l `mplus` psWrap r
- , psTheme = psTheme l `mappend` psTheme r
+ { psRows = psRows l `mplus` psRows r
+ , psColumns = psColumns l `mplus` psColumns r
+ , psWrap = psWrap l `mplus` psWrap r
+ , psTheme = psTheme l <> psTheme r
+ , psIncrementalLists = psIncrementalLists l `mplus` psIncrementalLists r
+ , psAutoAdvanceDelay = psAutoAdvanceDelay l `mplus` psAutoAdvanceDelay r
}
--------------------------------------------------------------------------------
defaultPresentationSettings :: PresentationSettings
defaultPresentationSettings = PresentationSettings
- { psRows = Nothing
- , psColumns = Nothing
- , psWrap = Nothing
- , psTheme = Just Theme.defaultTheme
+ { psRows = Nothing
+ , psColumns = Nothing
+ , psWrap = Nothing
+ , psTheme = Just Theme.defaultTheme
+ , psIncrementalLists = Nothing
+ , psAutoAdvanceDelay = Nothing
}
--------------------------------------------------------------------------------
-newtype Slide = Slide {unSlide :: [Pandoc.Block]}
+newtype Slide = Slide {unSlide :: [Fragment]}
deriving (Monoid, Show)
--------------------------------------------------------------------------------
+newtype Fragment = Fragment {unFragment :: [Pandoc.Block]}
+ deriving (Monoid, Show)
+
+
+--------------------------------------------------------------------------------
+-- | Active slide, active fragment.
+type Index = (Int, Int)
+
+
+--------------------------------------------------------------------------------
+getSlide :: Int -> Presentation -> Maybe Slide
+getSlide sidx = listToMaybe . drop sidx . pSlides
+
+
+--------------------------------------------------------------------------------
+getActiveFragment :: Presentation -> Maybe Fragment
+getActiveFragment presentation = do
+ let (sidx, fidx) = pActiveFragment presentation
+ Slide fragments <- getSlide sidx presentation
+ listToMaybe $ drop fidx fragments
+
+
+--------------------------------------------------------------------------------
$(A.deriveJSON A.dropPrefixOptions ''PresentationSettings)