summaryrefslogtreecommitdiff
path: root/lib/Patat/Presentation/Interactive.hs
blob: 6707e099a0eb4ac1c84cd0e9f3b542e89e417ea2 (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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
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
                }