diff options
Diffstat (limited to 'src/Patat/Presentation/Internal.hs')
| -rw-r--r-- | src/Patat/Presentation/Internal.hs | 78 |
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) |