blob: 8bd2729c09844c038f7083588eaa176cc92ca30a (
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
|
-- Copyright © 2015 Benjamin Barenblat
--
-- Licensed under the Apache License, Version 2.0 (the "License"); you may not
-- use this file except in compliance with the License. You may obtain a copy
-- of the License at
--
-- http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
-- License for the specific language governing permissions and limitations under
-- the License.
module Main (main) where
import Prelude hiding (lines, log)
import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.Chan
import Control.Monad (forever, void)
import Data.Default.Class (def)
import Data.IORef
import Graphics.Vty (Vty)
import qualified Graphics.Vty as Vty
import Flag (Flag)
import qualified Flag
main :: IO ()
main = do
terminal <- Vty.mkVty def
initialize terminal
jarvis terminal
Vty.shutdown terminal
initialize :: Vty -> IO ()
initialize _ = return ()
jarvis :: Vty -> IO ()
jarvis terminal = do
log <- newIORef Vty.emptyImage
prompt <- newIORef Vty.emptyImage
promptInput <- newChan
ready <- Flag.new
void $ forkIO $ redrawer ready log prompt terminal
void $ forkIO $ prompter promptInput prompt ready
void $ forkIO $ logger log ready
processEvents terminal promptInput
processEvents :: Vty -> Chan Vty.Event -> IO ()
processEvents terminal promptInput = do
event <- Vty.nextEvent terminal
case event of
Vty.EvKey (Vty.KChar 'd') [Vty.MCtrl] -> return ()
Vty.EvKey (Vty.KChar _) _ -> writeChan promptInput event >> continue
_ -> continue
where continue = processEvents terminal promptInput
prompter :: Chan Vty.Event -> IORef Vty.Image -> Flag -> IO ()
prompter input output redraw = do
let promptString = "> "
writeIORef output $ Vty.string def promptString
Flag.wave redraw
readCommand ""
where readCommand command = do
event <- readChan input
case event of
Vty.EvKey (Vty.KChar c) _ -> do
let command' = command ++ [c]
writeIORef output $ Vty.string def $ "> " ++ command'
Flag.wave redraw
readCommand command'
_ -> readCommand command
logger :: IORef Vty.Image -> Flag -> IO ()
logger output redraw = log 0 []
where log :: Integer -> [String] -> IO ()
log n lines = do
let lines' = lines ++ ["<" ++ show n ++ ">"]
writeIORef output $ Vty.vertCat $ map (Vty.string def) lines'
Flag.wave redraw
threadDelay 200000
log (n + 1) lines'
redrawer :: Flag -> IORef Vty.Image -> IORef Vty.Image -> Vty -> IO ()
redrawer ready log prompt terminal = forever $ do
Flag.wait ready
(_maxX, maxY) <- Vty.displayBounds $ Vty.outputIface terminal
images <- sequence $ map readIORef [log, prompt]
let stack = resizeHeight' maxY $ Vty.vertCat images
Vty.update terminal $ Vty.picForImage stack
Vty.refresh terminal
resizeHeight' :: Int -> Vty.Image -> Vty.Image
resizeHeight' h i = case h `compare` Vty.imageHeight i of
LT -> Vty.cropTop h i
EQ -> i
GT -> Vty.translateY (h - Vty.imageHeight i) i
|
