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
}
|
