summaryrefslogtreecommitdiff
path: root/src/Patat/Presentation/Interactive.hs
blob: 226a715e39b110bc79ed8050f539a6154d283747 (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
--------------------------------------------------------------------------------
-- | 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 (\x -> x + 1)
    Backward     -> return $ goToSlide (\x -> x - 1)
    SkipForward  -> return $ goToSlide (\x -> x + 10)
    SkipBackward -> return $ goToSlide (\x -> x - 10)
    First        -> return $ goToSlide (\_ -> 0)
    Last         -> return $ goToSlide (\_ -> numSlides presentation - 1)
    Reload       -> reloadPresentation
  where
    numSlides pres = length (pSlides pres)
    clip idx  pres = min (max 0 idx) (numSlides pres - 1)

    goToSlide f = UpdatedPresentation $
        presentation {pActiveSlide = clip (f $ pActiveSlide presentation) presentation}

    reloadPresentation = do
        errOrPres <- readPresentation (pFilePath presentation)
        return $ case errOrPres of
            Left  err  -> ErroredPresentation err
            Right pres -> UpdatedPresentation $
                pres {pActiveSlide = clip (pActiveSlide presentation) pres}