summaryrefslogtreecommitdiff
path: root/lib/Patat/Presentation/Interactive.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Patat/Presentation/Interactive.hs')
-rw-r--r--lib/Patat/Presentation/Interactive.hs142
1 files changed, 142 insertions, 0 deletions
diff --git a/lib/Patat/Presentation/Interactive.hs b/lib/Patat/Presentation/Interactive.hs
new file mode 100644
index 0000000..6707e09
--- /dev/null
+++ b/lib/Patat/Presentation/Interactive.hs
@@ -0,0 +1,142 @@
+--------------------------------------------------------------------------------
+-- | Module that allows the user to interact with the presentation
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module Patat.Presentation.Interactive
+ ( PresentationCommand (..)
+ , readPresentationCommand
+
+ , UpdatedPresentation (..)
+ , updatePresentation
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Data.Char (isDigit)
+import Patat.Presentation.Internal
+import Patat.Presentation.Read
+import qualified System.IO as IO
+import Text.Read (readMaybe)
+
+
+--------------------------------------------------------------------------------
+data PresentationCommand
+ = Exit
+ | Forward
+ | Backward
+ | SkipForward
+ | SkipBackward
+ | First
+ | Last
+ | Reload
+ | Seek Int
+ | UnknownCommand String
+ deriving (Eq, Show)
+
+
+--------------------------------------------------------------------------------
+readPresentationCommand :: IO.Handle -> IO PresentationCommand
+readPresentationCommand h = do
+ k <- readKeys
+ case k of
+ "q" -> return Exit
+ "\n" -> return Forward
+ "\DEL" -> return Backward
+ "h" -> return Backward
+ "j" -> return SkipForward
+ "k" -> return SkipBackward
+ "l" -> return Forward
+ -- Arrow keys
+ "\ESC[C" -> return Forward
+ "\ESC[D" -> return Backward
+ "\ESC[B" -> return SkipForward
+ "\ESC[A" -> return SkipBackward
+ -- PageUp and PageDown
+ "\ESC[6" -> return Forward
+ "\ESC[5" -> return Backward
+ "0" -> return First
+ "G" -> return Last
+ "r" -> return Reload
+ -- Number followed by enter
+ _ | Just n <- readMaybe k -> return (Seek n)
+ _ -> return (UnknownCommand k)
+ where
+ readKeys :: IO String
+ readKeys = do
+ c0 <- IO.hGetChar h
+ case c0 of
+ '\ESC' -> do
+ c1 <- IO.hGetChar h
+ case c1 of
+ '[' -> do
+ c2 <- IO.hGetChar h
+ return [c0, c1, c2]
+ _ -> return [c0, c1]
+
+ _ | isDigit c0 && c0 /= '0' -> (c0 :) <$> readDigits
+
+ _ -> return [c0]
+
+ readDigits :: IO String
+ readDigits = do
+ c <- IO.hGetChar h
+ if isDigit c then (c :) <$> readDigits else return [c]
+
+
+--------------------------------------------------------------------------------
+data UpdatedPresentation
+ = UpdatedPresentation !Presentation
+ | ExitedPresentation
+ | ErroredPresentation String
+ deriving (Show)
+
+
+--------------------------------------------------------------------------------
+updatePresentation
+ :: PresentationCommand -> Presentation -> IO UpdatedPresentation
+
+updatePresentation cmd presentation = case cmd of
+ Exit -> return ExitedPresentation
+ Forward -> return $ goToSlide $ \(s, f) -> (s, f + 1)
+ Backward -> return $ goToSlide $ \(s, f) -> (s, f - 1)
+ SkipForward -> return $ goToSlide $ \(s, _) -> (s + 10, 0)
+ SkipBackward -> return $ goToSlide $ \(s, _) -> (s - 10, 0)
+ First -> return $ goToSlide $ \_ -> (0, 0)
+ Last -> return $ goToSlide $ \_ -> (numSlides presentation, 0)
+ Seek n -> return $ goToSlide $ \_ -> (n - 1, 0)
+ Reload -> reloadPresentation
+ UnknownCommand _ -> return (UpdatedPresentation presentation)
+ where
+ numSlides :: Presentation -> Int
+ numSlides pres = length (pSlides pres)
+
+ clip :: Index -> Presentation -> Index
+ clip (slide, fragment) pres
+ | slide >= numSlides pres = (numSlides pres - 1, lastFragments - 1)
+ | slide < 0 = (0, 0)
+ | fragment >= numFragments' slide =
+ if slide + 1 >= numSlides pres
+ then (slide, lastFragments - 1)
+ else (slide + 1, 0)
+ | fragment < 0 =
+ if slide - 1 >= 0
+ then (slide - 1, numFragments' (slide - 1) - 1)
+ else (slide, 0)
+ | otherwise = (slide, fragment)
+ where
+ numFragments' s = maybe 1 numFragments (getSlide s pres)
+ lastFragments = numFragments' (numSlides pres - 1)
+
+ goToSlide :: (Index -> Index) -> UpdatedPresentation
+ goToSlide f = UpdatedPresentation $ presentation
+ { pActiveFragment = clip (f $ pActiveFragment presentation) presentation
+ }
+
+ reloadPresentation = do
+ errOrPres <- readPresentation (pFilePath presentation)
+ return $ case errOrPres of
+ Left err -> ErroredPresentation err
+ Right pres -> UpdatedPresentation $ pres
+ { pActiveFragment = clip (pActiveFragment presentation) pres
+ }