blob: 6e7496be694919ef6315c48d3f07b1323a4373f1 (
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
|
-- 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.MSampleVar
import Control.Monad (forever, void)
import Data.Default.Class (def)
import Graphics.Vty (Vty)
import qualified Graphics.Vty as Vty
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 <- newSV Vty.emptyImage
prompt <- newSV Vty.emptyImage
ready <- newEmptySV
void $ forkIO $ redrawer ready log prompt terminal
void $ forkIO $ prompter prompt ready
void $ forkIO $ logger log ready
void $ Vty.nextEvent terminal
prompter :: MSampleVar Vty.Image -> MSampleVar () -> IO ()
prompter output redraw = prompt' 0
where prompt' :: Integer -> IO ()
prompt' n = do
writeSV output $ Vty.string def ("jarvis " ++ show n ++ " >")
writeSV redraw ()
threadDelay 1000000
prompt' (n + 1)
logger :: MSampleVar Vty.Image -> MSampleVar () -> IO ()
logger output redraw = log 0 []
where log :: Integer -> [String] -> IO ()
log n lines = do
let lines' = lines ++ ["<" ++ show n ++ ">"]
writeSV output $ Vty.vertCat $ map (Vty.string def) lines'
writeSV redraw ()
threadDelay 200000
log (n + 1) lines'
redrawer :: MSampleVar () -> MSampleVar Vty.Image -> MSampleVar Vty.Image -> Vty -> IO ()
redrawer ready log prompt terminal = forever $ do
void $ readSV ready
(_maxX, maxY) <- Vty.displayBounds $ Vty.outputIface terminal
images <- sequence $ map readSV [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
|
