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