summaryrefslogtreecommitdiff
path: root/src/Patat/Presentation/Interactive.hs
blob: d7d7d53179d68fdcb3260f2aae25de92453d34c4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
--------------------------------------------------------------------------------
-- | 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           Patat.Presentation.Internal
import           Patat.Presentation.Read


--------------------------------------------------------------------------------
data PresentationCommand
    = Exit
    | Forward
    | Backward
    | SkipForward
    | SkipBackward
    | First
    | Last
    | Reload


--------------------------------------------------------------------------------
readPresentationCommand :: IO PresentationCommand
readPresentationCommand = do
    k <- readKey
    case k of
        "q"      -> return Exit
        "\n"     -> return Forward
        "\DEL"   -> return Backward
        "h"      -> return Backward
        "j"      -> return SkipForward
        "k"      -> return SkipBackward
        "l"      -> return Forward
        "\ESC[C" -> return Forward
        "\ESC[D" -> return Backward
        "\ESC[B" -> return SkipForward
        "\ESC[A" -> return SkipBackward
        "0"      -> return First
        "G"      -> return Last
        "r"      -> return Reload
        _        -> readPresentationCommand
  where
    readKey :: IO String
    readKey = do
        c0 <- getChar
        case c0 of
            '\ESC' -> do
                c1 <- getChar
                case c1 of
                    '[' -> do
                        c2 <- getChar
                        return [c0, c1, c2]
                    _ -> return [c0, c1]
            _ -> return [c0]


--------------------------------------------------------------------------------
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)
    Reload       -> reloadPresentation
  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 (length . unSlide) (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
                }